AW: Access-Daten Import per VBA
02.03.2007 20:32:00
Peter
Servus,
z.B. so. genaueres eingehen auf dein Problem ist ohne Kenntnisse der Access DB nicht möglich.
'Hinweiß für Verweise
'Verweis aus MS.Access V x.x Object Library muss aktiviert sein (getestet mit 10.0)
'Verweis auf DAO x.x Object Library muss aktiviert sein (getestet mit 3.6)
'Public Variablen
Public objDB As Object, myTab As Object
Public myRS As Recordset
Public wks(1) As Worksheet
Public strfield(3, 22) As String, FieldsArr() As String, TableArr() As String
Public lngFieldsC As Long
Public Sub basFields(ByVal myTable As String, ByVal TableNr As Integer, Modus As Boolean)
Dim lngCount As Long, arrCount As Long
Dim intFor As Integer
Dim SQL As String
On Error GoTo errHandler
'Konstante Variablen für Fields -
'Änderungen an Fields müssen hier vorgenommen werden !!!
' Fields für Warengruppen
strfield(0, 0) = "[WGR_ID]": strfield(0, 1) = "[Bezeichnung]"
strfield(0, 2) = "[Beschreibung]"
' Fields für Rezeptdaten
strfield(1, 0) = "[Rezept_ID]": strfield(1, 1) = "[Bezeichnung]"
strfield(1, 2) = "[WGR_ID]"
strfield(1, 3) = "[Zutaten_ID_1]": strfield(1, 4) = "[Zutaten_ID_2]"
strfield(1, 5) = "[Zutaten_ID_3]": strfield(1, 6) = "[Zutaten_ID_4]"
strfield(1, 7) = "[Zutaten_ID_5]": strfield(1, 8) = "[Zutaten_ID_6]"
strfield(1, 9) = "[Zutaten_ID_7]": strfield(1, 10) = "[Zutaten_ID_8]"
strfield(1, 11) = "[Zutaten_ID_9]": strfield(1, 12) = "[Zutaten_ID_10]"
strfield(1, 13) = "[Zutaten_ID_11]": strfield(1, 14) = "[Zutaten_ID_12]"
strfield(1, 15) = "[Zutaten_ID_13]": strfield(1, 16) = "[Zutaten_ID_14]"
strfield(1, 17) = "[Zutaten_ID_15]": strfield(1, 18) = "[Zutaten_ID_16]"
strfield(1, 19) = "[Zutaten_ID_17]": strfield(1, 20) = "[Zutaten_ID_18]"
strfield(1, 21) = "[Zutaten_ID_19]": strfield(1, 22) = "[Zutaten_ID_20]"
' Fields für Zutatendaten
strfield(2, 0) = "[Zutaten_ID]": strfield(2, 1) = "[Bezeichnung]"
strfield(2, 2) = "[Preis]"
' Fields für Sonstigesdaten
strfield(3, 0) = "[Sonstiges_ID]": strfield(3, 1) = "[Zutaten_ID]"
strfield(3, 2) = "[Rezept_ID]": strfield(3, 3) = "[Verlust]"
strfield(3, 4) = "[Gewicht]"
' Zuweisung der Worksheets
Set wks(0) = Sheets("Start_"): Set wks(1) = Sheets("DB_Ablage")
' Access-File Initalisieren
Set objDB = Access.Application.DBEngine.OpenDatabase(wks(0).Range("N15").Value)
' Zuweisung des/der Table
Set myTab = objDB.TableDefs(myTable)
' Zuweisung des Schleifenmaximums für SQL Schleife
Select Case TableNr
Case 0: intFor = 2: Case 1: intFor = 22
Case 2: intFor = 2: Case 3: intFor = 4
End Select
' Zuweisung des SQL
For lngCount = 0 To intFor
If lngCount = 0 Then 'Anfang
SQL = "SELECT " & myTab.Name & "." & strfield(TableNr, lngCount)
ElseIf lngCount = intFor Then 'Abschluss
SQL = SQL & ", " & myTab.Name & "." & strfield(TableNr, lngCount) & _
" FROM " & myTab.Name & ";"
Else
SQL = SQL & ", " & myTab.Name & "." & strfield(TableNr, lngCount)
End If
Next
' Zuweisung des Recordset
Set myRS = objDB.OpenRecordset(SQL)
' Fields in DB_Ablage schreiben
Do
For lngCount = 0 To intFor
If myRS.Fields(lngCount) <> "" Then _
wks(1).Cells(1 + arrCount, lngCount + 1).Value = _
myRS.Fields(lngCount)
Next
arrCount = arrCount + 1
myRS.MoveNext
Loop Until myRS.EOF
lngFieldsC = arrCount
' Objekte entladen
myRS.Close: objDB.Close
Exit Sub
errHandler:
Debug.Print SQL & " / " & Len(SQL)
Debug.Print Err.Number; " / " & Err.Description
If Err.Number = 3021 And Modus Then
MsgBox "Es sind noch keine Daten in der Datenbank !", vbCritical, "Es können keine Daten _
eingelesen werden _
Else
' MsgBox Err.Description, vbCritical, Err.Number
End If
End Sub
MfG Peter
