Excel Schließen nach SQL Abfrage
edie
habe mal vor Zeiten vom Josef Ehrensberger ein Makro bekommen, dabei werden Werte aus
einer geschlossenen Datei gesucht bzw. ausgelesen. Siehe nachfolgende Code.
Nun das Problem: Beim ersten Makrostart funktioniert es tadellos, danach nicht mehr bis
ich Excel schließe, dann funktioniert das Makro wieder einwandfrei. Es scheit so, dass die
die Datei zwar mit ExcelTable.Open SQL geöffnet wird und bleibt offen bis man alles schließt.
Habe schon mal versucht mit "Set Con = Nothing" ohne Erfolg.
Meine Frage: Wie kann man die ExcelTable.Open SQL auch wieder schlissen?
Wie schliesse ich die SQL Abfrage?
Public Function ExcelTable(ByRef Path As String, ByRef Table As String, ByRef SourceRange As _
String) As Object
Dim SQL As String
Dim Con As String
SQL = "select * from [" & Table & "$" & SourceRange & "]"
Con = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Extended Properties=Excel 8.0;" _
& "Data Source=" & Path & ";"
Set ExcelTable = CreateObject("ADODB.Recordset")
ExcelTable.Open SQL, Con, 3, 1
End Function
Sub Test()
Dim vntA As Variant, vntB As Variant, vntC As Variant, vntRes As Variant
Dim strFile As String, strTab As String, strRange1 As String, strRange2 As String
Dim lngIndexA As Long
Dim sDatei As String
Dim shA As Worksheet
sDatei = Range("A1").Value
On Error Resume Next
strFile = ThisWorkbook.Path & "\EDV\" & sDatei
strTab = "Tabbele1"
strRange1 = "A1:B20000"
Set shA = ActiveSheet ' aktuelle Tabelle
With ExcelTable(strFile, strTab, strRange1)
vntB = .GetRows(, , 0)
.MoveFirst
vntC = .GetRows(, , 1)
.Close
End With
vntA = shA.Range(shA.Cells(4, 1), shA.Cells(shA.Cells(shA.Rows.Count, 1).End(xlUp).Row, 7))
For lngIndexA = 1 To UBound(vntA, 1)
vntRes = Application.Match(CStr(vntA(lngIndexA, 1)), vntB, 0)
If IsNumeric(vntRes) Then
vntA(lngIndexA, 7) = vntC(0, vntRes - 1)
End If
Next
shA.Range(shA.Cells(4, 1), shA.Cells(shA.Cells(shA.Rows.Count, 1).End(xlUp).Row, 7)) = vntA
End Sub
Hat jemand einen Vorschlag und kann helfen?
Vielen Dank im Voraus.
Grüße
Anzeige