Code optimieren ADODB "Query"
05.03.2024 18:11:40
Richi
Hoffe jemand von euch kann mir helfen den Code zu optimieren.
Ich kopiere mit open.connection im Hintergrund Daten in eine Tabelle. Stehe an bei folgendem Code:
Query = "SELECT * FROM [Daten$] WHERE Per ='" & SelectPer & "'" die Where Abfrage generiert Probleme:
Fehlermeldung Laufzeitfaufzeitfehler '-2147217904 (80040e10'):
[Microsoft][ODBC-Treiber für Excel ¨1 Parameter wurden erwartet, aber es wurden zuwenig Parameter übergeben.
Ich gehe davon aus, dass es an dem Code-Teil hängt: Query = "SELECT * FROM [Daten$] WHERE Per ='" & SelectPer & "'"
Nehme ich den Where Teil weg, läuft Programm einwandfrei durch. Query = "SELECT * FROM [Daten$]" 'WHERE Per ='" & SelectPer & "'"
Der Nachteil ist, dass ich die ganze Tabelle übernehme, welche viel zu viele Daten beinhaltet. Ich möchtejeweils nur eine Personalnummer (Alphanumerisch) auswerten.
Einen Workaround habe ich, jedoch läuft dieser zu lange. hab diesen ganz unten angefügt.
Ein weiteres "kleines" Problem habe ich noch. Beim einfügen der Daten wird die Tabellenbeschriftung eingelesen, obschon ich HDR auf No gesetzt habe oder interpretiere ich HDR falsch?
Liebe Gruess
Richi
--------------------------------------
Sub ADO1()
Dim Connection As New ADODB.Connection
Dim Query, FileDir As String
Dim rs As New ADODB.Recordset
Dim wb As Workbook
Dim WsRef, wsD As Worksheet
Dim SelectPer As Double
Set wb = ThisWorkbook
Set WsRef = wb.Worksheets("References")
Set wsD = wb.Worksheets("DataImport")
SelectPer = CDbl(WsRef.Cells(4, 11))
FileDir = WsRef.Cells(17, 12) & ";HDR=No;"
'Connection herstellen
Connection.Open "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & FileDir
Query = "SELECT * FROM [Daten$] WHERE Per ='" & SelectPer & "'"
'Query = "SELECT * FROM [Daten$]"
rs.Open Query, Connection
'Daten ins Tabellenblatt laden
wsD.Range("A1").CopyFromRecordset rs
'Connection schließen
rs.Close
Connection.Close
End Sub
-------------------Workaround--------------------------
Sub ADO()
Dim Connection As New ADODB.Connection
Dim Query As String
Dim rs As New ADODB.Recordset
Dim wb As Workbook
Dim WsRef, wsD As Worksheet
Dim SelectPer, FileDir As String
Dim i, lzD As Integer
Set wb = ThisWorkbook
Set WsRef = wb.Worksheets("References")
Set wsD = wb.Worksheets("DataImport")
'--------------------------Startblock zur Geschwindigkeitserhöhung bei Schleifen------------------------
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
SelectPer = WsRef.Cells(4, 11)
FileDir = WsRef.Cells(17, 12) & ";HDR=No;"
'Connection herstellen
Connection.Open "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & FileDir
Query = "SELECT * FROM [Daten$]"
rs.Open Query, Connection
'Daten ins Tabellenblatt laden
wsD.Range("A2").CopyFromRecordset rs
'Connection schließen
rs.Close
Connection.Close
lzD = wsD.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lzD
lzD = wsD.Cells(Rows.Count, 1).End(xlUp).Row
If wsD.Cells(i, 1) = SelectPer Then
Else
Rows(i).Delete
If wsD.Cells(i, 1) = "" Then
Exit Sub
Else
i = i - 1
End If
End If
Next i
'------------------------------------Endblock zur Geschwindigkeitserhöhung bei Schleifen------------------------------------
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub