Auslesen aller .ODBCConnection
Martin
Einmal mehr Ratlos.
Da kann nur die Herber Gemeinde weiterhelfen.
Ausgangslage:
Habe ein Problem mit meinen bestehenden Makros welches alle Querytables ausliest und auflistet in einem neuen Tabellenblatt. Dies ist hilfreich/notwendig wenn viele Abfragen in einer Arbeitsmappe vorhanden sind und die Datenbank sich verändert, damit der sich veränderte Connectionstring mithilfe dieser Makros angepasst werden kann.
Arbeitsschritte:
Schritt 1: alle Qureys auslesen (mit Makro: "QuerysAuslesen()")
Schritt 2: alle Connectionstrings anpassen
Schritt 3: alle Querrys updaten (mit Makro: "QueriesEinlesen()")
Nun zum Problem:
Eine in Excel 2010 erstellte ODBC Abfrage wird nicht gefunden. Die Abfrage ist aber mit Garantie existent.
Verwirrend ist, eine bestehnde Abfrage welche noch mit der Version 2003 erstellt wurde kann ohne weiteres ausgelesen werden auch wenn das File in die Version 2010 konvertiert wurde.
Ist hier ein möglicher Fehler im Script? (war ursprünglich für 2003 unter Mithilfe des Herber Forums erstellt worden)
Makro zum Auslesen:
Sub QuerysAuslesen()
Dim qrt As QueryTable
Dim wsh As Worksheet
Dim bAddList As Boolean
Dim qrt_Anzahl As Integer
qrt_Anzahl = 0
bAddList = True
For Each wsh In ActiveWorkbook.Worksheets
If wsh.Name = "QuerryTables" Then
bAddList = False
Exit For
End If
Next
If bAddList Then
ActiveWorkbook.Sheets.Add Before:=ActiveWorkbook.Worksheets(1)
ActiveSheet.Name = "QuerryTables"
End If
Sheets("QuerryTables").Cells(1, 1).Value = "BlattName"
Sheets("QuerryTables").Cells(1, 2).Value = "QueryName"
Sheets("QuerryTables").Cells(1, 3).Value = "ConnectionString"
Sheets("QuerryTables").Cells(1, 4).Value = "SQLString"
For Each wsh In ActiveWorkbook.Worksheets
For Each qrt In wsh.QueryTables
qrt_Anzahl = qrt_Anzahl + 1
Sheets("QuerryTables").Cells(1 + qrt_Anzahl, 1) = wsh.Name
Sheets("QuerryTables").Cells(1 + qrt_Anzahl, 2) = qrt.Name
Sheets("QuerryTables").Cells(1 + qrt_Anzahl, 3) = qrt.Connection
Sheets("QuerryTables").Cells(1 + qrt_Anzahl, 4) = qrt.Sql
Next
Next
If qrt_Anzahl = 0 Then
MsgBox "Keine Queries in dieser Arbeitsmappe", vbExclamation
Else
MsgBox "Total " & qrt_Anzahl & " Queries in der Arbeitsmappe.", vbInformation
End If
End Sub
Makro zum einlesen der angepassten Querys:
Sub QueriesEinlesen()
Dim qrt As QueryTable
Dim wsh As Worksheet
Dim Tab_vorhanden As Boolean
Dim qrt_Anzahl As Integer
Tab_vorhanden = False
For Each wsh In ActiveWorkbook.Worksheets
If wsh.Name = "QuerryTables" Then
Tab_vorhanden = True
Exit For
End If
Next
If Not (Tab_vorhanden) Then
MsgBox "QuerryTables existiert nicht !" & vbCrLf & _
"Keine Queries angepasst", vbCritical
Exit Sub
End If
For Each wsh In ActiveWorkbook.Worksheets
For Each qrt In wsh.QueryTables
qrt_Anzahl = 1
Do While Sheets("QuerryTables").Cells(1 + qrt_Anzahl, 1).Value ""
If wsh.Name = Sheets("QuerryTables").Cells(1 + qrt_Anzahl, 1).Value And _
qrt.Name = Sheets("QuerryTables").Cells(1 + qrt_Anzahl, 2) Then
qrt.Connection = Sheets("QuerryTables").Cells(1 + qrt_Anzahl, 3).Value
qrt.Sql = Sheets("QuerryTables").Cells(1 + qrt_Anzahl, 4).Value
MsgBox "Blatt:" & wsh.Name & vbCrLf & _
"Query:" & qrt.Name & " angepasst!", vbInformation
End If
qrt_Anzahl = qrt_Anzahl + 1
Loop
Next
Next
End Sub
Anzeige