AW: Verbindungspfad aktualisieren
20.10.2014 15:41:21
fcs
Hallo Sascha,
eine automatische Aktualisierung ist nur per Makro möglich.
Wenn die Abfrage auf die Daten innerhalb der Datei via Micorsoft-Querry erstellt ist, dann sollte folgendes Makro die Pfadangaben ggf. ersetzen/korrigieren.
Gruß
Franz
'Code im VBA-Editor unter "DieseArbeitsmappe" der Datei
Private Sub Workbook_Open()
Call UpdateDatenverbindung
End Sub
'Code unter DieseArbeitsmappe oder in einem allgemeinen Modul der Datei
Sub UpdateDatenverbindung()
'Update der Abfragedefinition, wenn die Quelle in dieser Datei ist und _
die Datei unter einem anderen Namen gespeichert wird.
Dim strConOld As String, strConNeu As String
Dim strComOld As String, strComNeu As String
Dim strPath As String, strFullName As String
Dim strPathOld As String, strFullNameOld As String
Dim strText As String, Pos1 As Integer, Pos2 As Integer
Dim objCon As Object
'Name und Pfad dieser Datei
strPath = ThisWorkbook.Path
strFullName = strPath & Application.PathSeparator & ThisWorkbook.Name
'Daten der 1. Verbindung in der Datei
Set objCon = ThisWorkbook.Connections(1)
strConOld = objCon.ODBCConnection.Connection
strComOld = objCon.ODBCConnection.CommandText
'Debug.Print strConOld
'Debug.Print strComOld
'Dateiname im Connection String
strText = strConOld
Pos1 = InStr(1, strText, "DBQ=") + Len("DBQ=")
Pos2 = InStr(Pos1, strText, ";")
strFullNameOld = Mid(strConOld, Pos1, Pos2 - Pos1)
'Pfad im Connection String
Pos1 = InStr(Pos2, strText, "DefaultDir=") + Len("DefaultDir=")
Pos2 = InStr(Pos1, strText, ";")
strPathOld = Mid(strConOld, Pos1, Pos2 - Pos1)
'Prüfen ob Dateiname dieser Datei mit Werten im Connection-String übereinstimmen
If LCase(strFullNameOld) = LCase(strFullName) Then
'MsgBox "Dateiname in Verbindung " & vbLf & strConOld & vbLf & "ist ok"
Else
'MsgBox "Dateiname in Verbindung " & vbLf & strConOld & vbLf & "ist nicht ok"
'Dateiname und Pfad im Connection-String ersetzen
Pos1 = InStr(1, strConOld, "DefaultDir=")
strText = Mid(strConOld, Pos1)
strConNeu = VBA.Replace(strText, strPathOld, strPath)
strText = Left(strConOld, Pos1 - 1)
strConNeu = VBA.Replace(strText, strFullNameOld, strFullName) & strConNeu
objCon.ODBCConnection.Connection = strConNeu
'Dateiname im Command-Text ersetzen
strComNeu = VBA.Replace(strComOld, strFullNameOld, strFullName)
objCon.ODBCConnection.CommandText = strComNeu
End If
ThisWorkbook.RefreshAll
End Sub