Code Snippet "VBA Excel"

Stellt für externe Query mit Access-DB Connection wieder her

funktioniert nur, wenn Excel- und Accessdatei im gleichen Verzeichnis sind und Access-Datei so heisst wie bezeichnet; Beim Öffnen die Shift-Taste halten, damit Makro nicht losgeht

Sub initializeConnection()
  Const sheetname = "dataquery"
  Const queryname = "businessgame"
  Const accessFileName = "businessgames.mdb"
  
  Dim newpath As String
  Dim oldpath As String
  Dim qy As QueryTable
  Dim tmp As String
  Set qy = ActiveWorkbook.Sheets(sheetname).QueryTables(queryname)
  tmp = qy.connection
  tmp = Mid(tmp, InStr(tmp, "DBQ=") + 4)
  oldpath = Left(tmp, InStr(tmp, ";") - (2 + Len(accessFileName)))
  newpath = ThisWorkbook.path
  Debug.Print "Alter Pfad: " & oldpath
  Debug.Print "Neuer Pfad: " & newpath
  
  qy.connection = _
      Application.Substitute(qy.connection, _
      oldpath, newpath)

  Debug.Print qy.connection

End Sub

'In thisWorkbook
Private Sub Workbook_Open()
  Call initializeConnection
End Sub