VBA-Script um Daten von CSV nach Access zu importieren

  • Sonstige

Es gibt 1 Antwort in diesem Thema. Der letzte Beitrag () ist von peterfido.

    VBA-Script um Daten von CSV nach Access zu importieren

    hallo leute und guten morgen (naja oder eher schon fast mahlzeit..)

    ich bin gerade dabei ein vba-modul zu schreiben, mit dem automatisch daten aus einer csv datei in eine tabelle von einer access db importiert werden sollen.
    ich bin auch schon nach langen suchen so weit, das ich die csv datei zeile für zeile auslesen kann und den zeileninhalt jeweils auf einer variable abspeichere.
    die access db kann ich auch öffnen.
    aber wenn es dann darum geht die betreffende tabelle zu öffnen und die daten hinein zu schreiben, dann hauts mich leider raus...
    das öffnen geht zwar aber die daten bekomme ich nicht rein.
    ich such schon seit einiger zeit den richtigen befehl, finde aber leider nichts
    da ich noch nicht wirklich viel erfahrung mit vba habe, würde ich ganz gern einen hinweiss bekommen, woran es bei meiner routine hakt

    Visual Basic-Quellcode

    1. Sub Import()
    3. Dim inhalt
    4. Close #1
    5. Open "c:\Test.csv" For Input As #1
    6. While Not EOF(1)
    7. Line Input #1, dummy
    8. inhalt = Split(dummy, ";")
    9. Open "c:\Test.mdb" For Random As #2
    10. DoCmd.OpenTable "Testtabelle", acAdd
    11. <hier fehlt mir der befehl zum reinschreiben der daten in die tabelle>
    12. Wend
    13. Close #1
    15. End Sub



    Edit by LaMa5: Bitte den [ VB ] Tag benutzen

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „LaMa5“ ()

    Du öffnest bei jedem Wert die Datenbank neu, ohne sie vorher zu schließen.

    Ansonsten kann ich ja mal nen Datenbankhandling meines MP3-Players posten.

    Vielleicht sind ja ein paar anregungen bei.VB

    Visual Basic-Quellcode

    1. Option Explicit
    3. ' Pfad+Name der Datenbank
    4. Global dbFile As String
    6. ' Datenbank-Objekt-Variable
    7. Global Db As Database
    9. ' Tabellen-Objekt
    10. Global Tabelle As Recordset
    12. Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    14. Public Type Lied
    15. Pfad As String
    16. DateiName As String
    17. Interpret As String
    18. Titel As String
    19. Zaehler As Long
    20. Nummer As Long
    21. Laenge As Long
    22. Jahr As Long
    23. Hinzu As Date
    24. Suche As String
    25. End Type
    27. Public Sub dbErstellen()
    28. Set Db = Workspaces(0).CreateDatabase(dbFile, _
    29. dbLangGeneral, dbVersion30)
    30. End Sub
    32. Public Function dbGesamt() As Long
    33. dbGesamt = Db.TableDefs("Lieder").RecordCount
    34. End Function
    37. Public Sub TabelleErstellen()
    39. 'dbFile = App.Path + DatenBank
    40. 'Set DB = Workspaces(0).CreateDatabase(dbFile, dbLangGeneral, dbVersion30)
    42. 'Set DB = DBEngine.CreateDatabase(dbFile, dbLangGeneral & ";pwd=" & s, dbEncrypt)
    44. Dim tbLieder As New TableDef
    45. Dim Feld As New Field
    47. tbLieder.name = "Lieder"
    49. 'Datenfeld #0
    50. Feld.name = "LiedNr"
    51. Feld.Type = dbLong
    52. Feld.Attributes = dbAutoIncrField
    53. tbLieder.Fields.Append Feld
    54. Set Feld = Nothing
    56. 'Datenfeld #1
    57. Feld.name = "DateiName"
    58. Feld.Type = dbText
    59. Feld.Size = 250
    60. Feld.AllowZeroLength = True
    61. tbLieder.Fields.Append Feld
    62. Set Feld = Nothing
    64. 'Datenfeld #2
    65. Feld.name = "Zähler"
    66. Feld.Type = dbLong
    67. 'Feld.Size = 20
    68. 'Feld.AllowZeroLength = True
    69. tbLieder.Fields.Append Feld
    70. Set Feld = Nothing
    72. Db.TableDefs.Append tbLieder
    75. 'Db.Close
    77. End Sub
    79. ' Datenbank öffnen
    80. ' Tabelle "Adressen" öffnen
    81. Public Sub dbOeffnen()
    82. Set Db = Workspaces(0).OpenDatabase(dbFile, _
    83. False, False)
    84. Set Tabelle = Db.OpenRecordset("Lieder")
    85. End Sub
    87. ' Datenbank schließen
    88. Public Sub dbSchliessen()
    89. On Local Error Resume Next
    90. If Not Tabelle Is Nothing Then Tabelle.Close
    91. If Not Db Is Nothing Then Db.Close
    92. Set Tabelle = Nothing
    93. Set Db = Nothing
    94. End Sub
    97. Sub Zählerhoch(ByVal DateiName As String)
    98. Dim Wert As Long
    100. If Trim(DateiName) = "" Then
    101. Exit Sub
    102. End If
    104. If Not SchonVorhanden(DateiName) Then
    105. 'dbOeffnen
    106. Tabelle.AddNew
    108. Tabelle(1) = DateiName
    109. Tabelle(2) = 1
    111. Tabelle.Update
    112. Log ("Zähler " & DateiName & ": 1")
    113. 'dbSchliessen
    114. Else
    115. Tabelle.index = "Name"
    117. 'Suchen
    118. Tabelle.Seek "=", DateiName
    119. Tabelle.Edit
    120. Wert = Tabelle(2)
    121. Wert = Wert + 1
    122. Log ("Zähler " & DateiName & Str(Wert))
    124. Tabelle(2) = Wert
    125. Tabelle.Update
    126. End If
    129. End Sub
    131. Sub Zählerrunter(ByVal DateiName As String)
    132. Dim Wert As Long
    134. If Trim(DateiName) = "" Then
    135. Exit Sub
    136. End If
    138. If Not SchonVorhanden(DateiName) Then
    139. Exit Sub
    140. Else
    141. Tabelle.index = "Name"
    143. 'Suchen
    144. Tabelle.Seek "=", DateiName
    145. Tabelle.Edit
    146. Wert = Tabelle(2)
    147. Wert = Wert - 1
    148. If Wert < 0 Then
    149. Wert = 0
    150. End If
    151. Log ("Zähler " & DateiName & Str(Wert))
    153. Tabelle(2) = Wert
    154. Tabelle.Update
    155. End If
    158. End Sub
    160. Private Function SchonVorhanden(ByVal Suche As String) As Boolean
    161. Static SuchText As String
    162. Static sIndex As Integer
    164. Dim Result As Boolean
    165. Dim CurRec As String
    166. Dim CurIdx As String
    167. Dim Feld As String
    170. 'Suchvorgang starten
    171. 'aktuellen Datensatz merken
    172. GetBookmark Tabelle, CurRec, CurIdx
    174. 'Index setzen
    175. Tabelle.index = "Name"
    177. 'Suchen
    178. Tabelle.Seek "=", Suche
    179. Result = (Not Tabelle.NoMatch)
    181. 'Such-Auswertung
    182. If Result Then
    183. SchonVorhanden = True
    184. Else
    185. SchonVorhanden = False
    187. 'Datensatzzeiger auf ursprünglichen Datensatz zurücksetzen
    188. SetBookmark Tabelle, CurRec, CurIdx
    189. End If
    190. End Function
    192. Sub FavoritenListeErstellen()
    193. Static SuchText As String
    194. Static sIndex As Integer
    196. Dim Result As Boolean
    197. Dim CurRec As String
    198. Dim CurIdx As String
    199. Dim Feld As String
    201. 'Suchvorgang starten
    202. 'aktuellen Datensatz merken
    203. GetBookmark Tabelle, CurRec, CurIdx
    205. 'Index setzen
    206. Tabelle.index = "Zähler"
    208. Tabelle.MoveFirst
    210. Nächster:
    211. If Not Trim(Tabelle(1)) = "" Then
    212. Form1.List3.AddItem Tabelle(1)
    213. End If
    214. Log ("Favorit: " & Tabelle(1) & "Z: " & Tabelle(2))
    215. If CanMoveNext(Tabelle) And Form1.List3.ListCount < 250 Then
    216. Tabelle.MoveNext
    217. GoTo Nächster
    218. End If
    220. 'Datensatzzeiger auf ursprünglichen Datensatz zurücksetzen
    221. SetBookmark Tabelle, CurRec, CurIdx
    222. End Sub
    224. Public Function ZählerLesen(ByVal DateiName As String) As Long
    225. Static SuchText As String
    226. Static sIndex As Integer
    228. Dim Result As Boolean
    229. Dim CurRec As String
    230. Dim CurIdx As String
    231. Dim Feld As String
    234. 'Suchvorgang starten
    236. 'Index setzen
    237. Tabelle.index = "Name"
    239. Tabelle.Seek "=", DateiName
    240. Result = (Not Tabelle.NoMatch)
    241. '
    242. 'Such-Auswertung
    243. If Result Then
    244. ZählerLesen = Tabelle(2)
    245. Else
    246. ZählerLesen = 0
    247. End If
    251. End Function

    Visual Basic-Quellcode

    1. Public Sub EintragLöschen(ByVal DateiName As String)
    2. Static SuchText As String
    3. Static sIndex As Integer
    5. Dim Result As Boolean
    6. Dim CurRec As String
    7. Dim CurIdx As String
    8. Dim Feld As String
    11. 'Suchvorgang starten
    13. 'Index setzen
    14. Tabelle.index = "Name"
    16. Tabelle.Seek "=", DateiName
    17. Result = (Not Tabelle.NoMatch)
    18. '
    19. 'Such-Auswertung
    20. If Result Then
    21. Tabelle.Delete
    22. If Tabelle.RecordCount > 0 Then
    23. If Not Tabelle.EOF Then
    24. Tabelle.MoveNext
    25. Else
    26. Tabelle.MoveLast
    27. End If
    28. End If
    29. End If
    33. End Sub
    35. Public Sub GetBookmark(Tabelle As Recordset, _
    36. CurRec As String, CurIdx As String)
    37. '
    38. '*** Datensatz-Zeiger merken ***
    39. '
    40. On Local Error Resume Next
    41. CurIdx = Tabelle.index
    42. CurRec = Tabelle.Bookmark
    43. If Err Then CurRec = ""
    44. On Local Error GoTo 0
    45. End Sub
    46. Public Function SetBookmark(Tabelle As Recordset, _
    47. CurRec As String, CurIdx As String) As Integer
    48. '
    49. '*** Datensatz-Zeiger zurücksetzen ***
    50. '
    51. Dim Result As Integer
    53. On Local Error Resume Next
    54. Result = True
    55. Tabelle.index = CurIdx
    56. If CurRec <> "" Then
    57. Tabelle.Bookmark = CurRec
    58. If Err <> 0 Then Result = False
    59. Else
    60. Tabelle.MoveLast
    61. Tabelle.MoveNext
    62. End If
    63. On Local Error GoTo 0
    65. SetBookmark = Result
    67. End Function
    70. ' Indexes erstellen
    71. Public Sub IndexesErstellen()
    72. Dim index As New index
    73. Dim antwort As Integer
    74. Dim TabWasOpen As Boolean
    76. ' Falls Tabelle geöffnet -> Hinweis und ggf. schliessen
    77. TabWasOpen = False
    78. If Not Tabelle Is Nothing Then
    79. TabWasOpen = True
    80. Tabelle.Close
    81. End If
    83. ' Fehlerbehandlung einschalten
    84. ' (falls Indexes bereits existieren!)
    85. ' On Local Error GoTo IndexCreate_Error
    87. ' LfNr (PrimaryKey)
    88. index.name = "Nr"
    89. index.Primary = True
    90. index.Unique = True
    91. index.Fields = "LiedNr"
    93. 'Hinzufügen zur Indexes-Auflistung
    94. Db.TableDefs("Lieder").Indexes.Append index
    95. Set index = Nothing
    97. ' Name
    98. index.name = "Name"
    99. index.Primary = False
    100. index.Unique = False
    101. index.Fields = "DateiName"
    103. 'Hinzufügen zur Indexes-Auflistung
    104. Db.TableDefs("Lieder").Indexes.Append index
    105. Set index = Nothing
    107. ' Name
    108. index.name = "Zähler"
    109. index.Primary = False
    110. index.Unique = False
    111. index.Fields = "Zähler"
    113. 'Hinzufügen zur Indexes-Auflistung
    114. Db.TableDefs("Lieder").Indexes.Append index
    115. Set index = Nothing
    117. ' Falls Tabelle geöffnet war, jetzt wieder öffnen
    118. Set Tabelle = Db.OpenRecordset("Lieder")
    120. ' Fehlerbehandlung wieder ausschalten
    121. On Local Error GoTo 0
    122. Exit Sub
    124. IndexCreate_Error:
    125. If Err.Number = 3283 Or Err.Number = 3284 Then
    126. ' Index existiert bereits -> ignorieren
    127. Resume Next
    128. Else
    129. ' sonstiger Fehler -> Meldung anzeigen
    130. antwort = MsgBox("Fehler " & Err.Number & vbCrLf & Err.Description & vbCrLf & vbCrLf & "...beim Erstellen der Indexes", vbAbortRetryIgnore + vbCritical, "Fehler")
    131. If antwort = 4 Then Resume 0
    132. If antwort = 5 Then Resume Next
    133. Exit Sub
    134. End If
    135. End Sub
    138. Public Function FeldInhalt(Feld As Field) As Variant
    139. If IsNull(Feld.Value) Then
    140. If Feld.Type = dbInteger Or Feld.Type = dbLong Then
    141. FeldInhalt = 0
    142. ElseIf Feld.Type = dbBoolean Then
    143. FeldInhalt = False
    144. Else
    145. FeldInhalt = ""
    146. End If
    147. Else
    148. FeldInhalt = Feld.Value
    149. End If
    150. End Function
    152. ' Prüfen, ob vorwärtsgeblättert werden kann
    153. Public Function CanMoveNext(Tabelle As Recordset) As Boolean
    154. CanMoveNext = False
    155. If Tabelle.RecordCount > 0 Then
    156. On Local Error Resume Next
    157. Tabelle.MoveNext
    158. CanMoveNext = (Not Tabelle.EOF And Err = 0)
    159. Tabelle.MovePrevious
    160. On Local Error GoTo 0
    161. End If
    162. End Function
    164. ' Prüfen, ob zurückgeblättert werden kann
    165. Public Function CanMovePrevious(Tabelle As Recordset) As Boolean
    166. CanMovePrevious = False
    167. If Tabelle.RecordCount > 0 Then
    168. On Local Error Resume Next
    169. Tabelle.MovePrevious
    170. CanMovePrevious = (Not Tabelle.BOF And Err = 0)
    171. Tabelle.MoveNext
    172. On Local Error GoTo 0
    173. End If
    174. End Function



    Edit by LaMa5: VB Tag korrigiert
    Gruß
    Peterfido

    Keine Unterstützung per PN!

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „LaMa5“ ()

Facebook
Telefonspende