Fehler Fehler Fehler: need help
18.03.2005 15:30:47
wolfn
Ich versuche, meine Excel-Daten in eine Access-Datenbank zu exportieren.
Aber beim Code erscheint ständig eine Fehlermeldung, obwohl das Listing beinahe 1:1 abgetippt wurde.
Wer kann hier einmal querlesen?
Fehler: Objektvariable nicht definiert (ws.Cells)
Danke!!
Hier das Listing:
Sub übernehmen()
Dim DB1 As Database
Dim RS1 As Recordset
Dim ws As Worksheet
Dim Zelle As Range
Dim Blattname As String
Dim Bereich As Range
Dim i As Long
Dim sMDBFile1 As String
Dim sPasswort1 As String
sMDBFile1 = (ThisWorkbook.Path & "\Leistungsabrechnung.mdb")
Set DB1 = DBEngine.OpenDatabase(sMDBFile1)
Set RS1 = DB1.OpenRecordset(Name:="Daten", Type:=dbOpenDynaset)
a1 = Sheets("Transfer").Range("A1").Text
ActiveSheets = ("Transfer")
Set Bereich = Range("A1:BQ15")
'Blattname = ws.Name
i = 2 'Startzeile 2 da in 1 Überschriften
Do While ws.Cells(i, 1) <> ""
With RS1
.AddNew
.Fields(1) = ws.Cells(i, 1)
.Fields(2) = ws.Cells(i, 2)
.Fields(3) = ws.Cells(i, 3)
.Fields(4) = ws.Cells(i, 4)
.Fields(5) = ws.Cells(i, 5)
.Fields(6) = ws.Cells(i, 6)
.Fields(7) = ws.Cells(i, 7)
.Fields(8) = ws.Cells(i, 8)
.Fields(9) = ws.Cells(i, 9)
.Fields(10) = ws.Cells(i, 10)
.Fields(11) = ws.Cells(i, 11)
.Fields(12) = ws.Cells(i, 12)
.Fields(13) = ws.Cells(i, 13)
.Fields(14) = ws.Cells(i, 14)
.Fields(15) = ws.Cells(i, 15)
.Fields(16) = ws.Cells(i, 16)
.Fields(17) = ws.Cells(i, 17)
.Fields(18) = ws.Cells(i, 18)
.Fields(19) = ws.Cells(i, 19)
.Fields(20) = ws.Cells(i, 20)
.Fields(21) = ws.Cells(i, 21)
.Fields(22) = ws.Cells(i, 22)
.Fields(23) = ws.Cells(i, 23)
.Fields(24) = ws.Cells(i, 24)
.Fields(25) = ws.Cells(i, 25)
.Fields(26) = ws.Cells(i, 26)
.Fields(27) = ws.Cells(i, 27)
.Fields(28) = ws.Cells(i, 28)
.Fields(29) = ws.Cells(i, 29)
.Fields(30) = ws.Cells(i, 30)
.Fields(31) = ws.Cells(i, 31)
.Fields(32) = ws.Cells(i, 32)
.Fields(33) = ws.Cells(i, 33)
.Fields(34) = ws.Cells(i, 34)
.Fields(35) = ws.Cells(i, 35)
.Fields(36) = ws.Cells(i, 36)
.Fields(37) = ws.Cells(i, 37)
.Fields(38) = ws.Cells(i, 38)
.Fields(39) = ws.Cells(i, 39)
.Fields(40) = ws.Cells(i, 40)
.Fields(41) = ws.Cells(i, 41)
.Fields(42) = ws.Cells(i, 42)
.Fields(43) = ws.Cells(i, 43)
.Fields(44) = ws.Cells(i, 44)
.Fields(45) = ws.Cells(i, 45)
.Fields(46) = ws.Cells(i, 46)
.Fields(47) = ws.Cells(i, 47)
.Fields(48) = ws.Cells(i, 48)
.Fields(49) = ws.Cells(i, 49)
.Fields(50) = ws.Cells(i, 50)
.Fields(51) = ws.Cells(i, 51)
.Fields(52) = ws.Cells(i, 52)
.Fields(53) = ws.Cells(i, 53)
.Fields(54) = ws.Cells(i, 54)
.Fields(55) = ws.Cells(i, 55)
.Fields(56) = ws.Cells(i, 56)
.Fields(57) = ws.Cells(i, 57)
.Fields(58) = ws.Cells(i, 58)
.Fields(59) = ws.Cells(i, 59)
.Fields(60) = ws.Cells(i, 60)
.Fields(61) = ws.Cells(i, 61)
.Fields(62) = ws.Cells(i, 62)
.Fields(63) = ws.Cells(i, 63)
.Fields(64) = ws.Cells(i, 64)
.Fields(65) = ws.Cells(i, 65)
.Fields(66) = ws.Cells(i, 66)
.Fields(67) = ws.Cells(i, 67)
.Fields(68) = ws.Cells(i, 68)
.Fields(69) = ws.Cells(i, 69)
.Fields(70) = ws.Cells(i, 70)
.Update
End With
i = i + 1
Loop
DB1.Close
'With Sheets("Tabelle1")
'.Range("A1") = ""
'End With
End Sub