Export code nach Access
Markus
Ich habe folgendes Problem.
Mit dem Coden (siehe unten) prüfe und schreibe ich Daten in eine Access datenbank.
Leider geht das nur wenn jede Spalte in Access als TEXT Formatiert ist, wenn dies nicht der Fall ist, dann kommt folgende Fehlermeldung. "Datentyp-Konvertierungsfehler"
was kann ich tun um nich Die SPalten in Access in TEXT änderen zu müssen.
Vielen Dank schoneinmal im Vorraus
Gruß Markus
Sub Uebertragen()
Dim Datenbank As Object
Dim RS As Object
Dim strPath As String
Dim suchText As String
Dim i As Integer
Dim a As Integer
Dim s As Integer
's = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'letzte zeile
i = s
i = Cells(1, 10).Value ' + 1
For a = 2 To i
On Error Resume Next
Set Datenbank = CreateObject("DAO.DBEngine.36")
If Datenbank Is Nothing Then
Set Datenbank = CreateObject("DAO.DBEngine.35")
End If
If Datenbank Is Nothing Then
MsgBox "Fehlende Komponenten!", vbCritical, "schwerer Programmfehler!"
End
End If
On Error GoTo 0
strPath = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
Set Datenbank = Datenbank.OpenDatabase(strPath & "\MDDdatenbank.mdb", True, True)
Set RS = Datenbank.OpenRecordset("SELECT * FROM Artikelzusatzdaten")
suchText = "ID Like '" & Worksheets("Übergabe").Cells(a, 9).Value & "'"
With RS 'Recortset
.FindFirst suchText
If .NoMatch Or (.EOF And .BOF) Then
'DS mit dieser ID nicht gefunden
.AddNew
.Fields(0) = Worksheets("Übergabe").Cells(a, 9) ' ID
.Fields(1) = Worksheets("Übergabe").Cells(a, 10) ' BEZEICHNUN
.Fields(2) = Worksheets("Übergabe").Cells(a, 11) ' Typ
.Fields(3) = Worksheets("Übergabe").Cells(a, 12) ' Typ
.Fields(4) = Worksheets("Übergabe").Cells(a, 13) ' Typ
.Fields(5) = Worksheets("Übergabe").Cells(a, 14) ' Typ
.Fields(6) = Worksheets("Übergabe").Cells(a, 15) ' Typ
Else
'DS gefunden
.Edit
.Fields(1) = Worksheets("Übergabe").Cells(a, 10) ' BEZEICHNUN
.Fields(2) = Worksheets("Übergabe").Cells(a, 11) ' Typ
.Fields(3) = Worksheets("Übergabe").Cells(a, 12) ' Typ
.Fields(4) = Worksheets("Übergabe").Cells(a, 13) ' Typ
.Fields(5) = Worksheets("Übergabe").Cells(a, 14) ' Typ
.Fields(6) = Worksheets("Übergabe").Cells(a, 15) ' Typ
End If
.Update
.Close
End With
Next a
End Sub