Hallo,
Ich versuche zwei Access Tabelen, die jeweils eine eigenständige Datei sind über einen JOIN in Excel zu importieren.
Die Erste Tabelle(.sep) ist eine Produktliste, die zweite(.ses) gibt die Beschreibung zu dieser Produkt ID.
Beide Datein sind mit Access zu öffnen.
Im Moment bekomme ich folgende Fehlermeldung:
Option Explicit
Sub StücklisteJoinAbfrage()
'------------------------------------------------------------------------------------------
'
'------------------------------------------------------------------------------------------
'Benötigte Variablen deklarieren.
'---------------------------------------------------------
'Connections und Recordset
Dim con As Object
Dim con2 As Object
Dim rs As Object
'File und Tabelle
Dim AccessFile As String
Dim AccessPfad2 As String
Dim AccessFile2 As String
Dim strTable As String
Dim strTable2 As String
Dim AccessPassword As String
'SQL-Anweisung und Zähler
Dim SQL As String
Dim i As Integer
'-----------------------------------------------------
'Bildschirmflackern ausschalten.
Application.ScreenUpdating = False
'Pfade und Passwort spezifizieren.
'-----------------------------------------------------
AccessFile = "C:\Users\FE3\Desktop\SEP-Dateien\Ansicht-Netze_BW.sep"
AccessFile2 = "C:\Users\FE3\Desktop\Symbols\Types.ses"
AccessPfad2 = "C:\Users\FE3\Desktop\Symbols\"
AccessPassword = "SECRET"
'-----------------------------------------------------
'Tabellennamen für den Export auswählen.
'-----------------------------------------------------
strTable = "AllComponentTypesCount"
strTable2 = "Type"
On Error Resume Next
'-----------------------------------------------------
'Die ADODB Connection Objekte erstellen.
'-----------------------------------------------------
Set con = CreateObject("ADODB.connection")
Set con2 = CreateObject("ADODB.connection")
'-----------------------------------------------------
'Überprüfen ob es erstellt wurde.
'-----------------------------------------------------
If Err.Number <> 0 Then
MsgBox "Connection was not created!", vbCritical, "Connection Error"
Exit Sub
End If
On Error GoTo 0
'-----------------------------------------------------
'Verbindungen öffnen.
'-----------------------------------------------------
'Verbindung Stückliste
con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & AccessFile & ";" & _
"Jet OLEDB:Database Password=" & AccessPassword
'Verbindung Bauteildatenbank
con2.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & AccessFile2 & ";" & _
"Jet OLEDB:Database Password=" & AccessPassword
'-----------------------------------------------------
'SQL-Anweisung erstellen um die Daten aus der Tabelle zu ziehen.
'Benötige Informationen auswählen (Kurzbeschreibung etc.) für alle Produkte.
'-----------------------------------------------------
SQL = "SELECT * " _
& "FROM Ansicht-Netze_BW.sep AllComponentTypesCount AS 'Products' " _
& "LEFT JOIN [text;database=" & AccessPfad2 & "].Types.ses AS Types " _
& "ON AllComponentTypesCount.160040 = Types.Type"
On Error Resume Next
'-----------------------------------------------------
'ADODB Recordset Objekt erstellen.
'-----------------------------------------------------
Set rs = CreateObject("ADODB.Recordset")
'Überprüfen ob es erstellt wurde.
If Err.Number <> 0 Then
'Fehler! Objekte entlassen und verlassen.
Set rs = Nothing
Set con = Nothing
'Dem Benutzer Fehlermeldung anzeigen.
MsgBox "Recordset wurde nicht erstellt!", vbCritical, "Recordset Error"
Exit Sub
End If
On Error GoTo 0
'Cursor Platzierung festlegen .
rs.CursorLocation = 3 'adUseClient on early binding
rs.CursorType = 1 'adOpenKeyset on early binding
'Recordset öffnen.
rs.Open SQL, con
'Überprüfen ob Recordset leer ist.
If rs.EOF And rs.BOF Then
'Recordset und Connection schließen.
rs.Close
con.Close
'Objekte entlassen.
Set rs = Nothing
Set con = Nothing
Set con2 = Nothing
'Bildschirm aktivieren.
Application.ScreenUpdating = True
'Wenn Recordset leer ist, Fehler ausgeben.
MsgBox "Keine Aufzeichnungen im Recordset!", vbCritical, "No Records"
Exit Sub
End If
'Recordset Überschriften kopieren.
For i = 0 To rs.Fields.count - 1
Sheets("Stückliste").Cells(1, i + 1) = rs.Fields(i).Name
Next i
'Anweisungswerte in Excel eintragen.
Sheets("Stückliste").Range("A2").CopyFromRecordset rs
'Recordset und Connection schließen.
rs.Close
con.Close
'Objekte entlassen.
Set rs = Nothing
Set con = Nothing
'Spaltenweite anpassen.
Sheets("Stückliste").Columns("A:E").AutoFit
'Bildschirm aktivieren.
Application.ScreenUpdating = True
'Benutzer informieren, dass das Makro erfolgreich ausgeführt wurde.
MsgBox "Produktliste wurde erfolgreich aus '" & strTable & "' generiert!", vbInformation, "Done"
End Sub
Sieht jemand hier einen banalen Fehler, oder sollte ich die Sache anders angehen?
Vielen Dank
|