Access Datenbanktabelle in eine CSV-Datei exportieren (mit Statusanzeige)

    • VB6

      Access Datenbanktabelle in eine CSV-Datei exportieren (mit Statusanzeige)

      Liebe Programmiererkollegen,

      da ich auch immer noch einige Programme in VB6 warten und erweitern muss, kommt es immer noch vor, dass ich eigene Funktionen dafür schreiben muss.
      Bis jetzt hatte ich in den Programmen einen EXCEL-Export welcher mit wenigen Zeilen von Access selbst gemacht werden konnte.
      Seit einem der letzten Windows-Updates funktioniert das aber unter Win7, Win8 und Win10 nicht mehr.

      Daher habe ich diese Tage einen manuellen Export in CSV geschrieben.

      Übergeben wird der Routine lediglich die Datenbank, die zu exportierende Tabelle, ggf. ein Datenbankpasswort, ein optionaler SQL-Sortierstring und die Zieldatei.

      Aufgerufen wirds so:

      Visual Basic-Quellcode

      1. exportcsv "c:/hotel/gast.mdb", "gast", "c:/temp/Hotel_Gästeliste", "passworthier", " ORDER BY Nachname"


      Hier der Code:

      Visual Basic-Quellcode

      1. ''' Exportiert eine Tabelle einer Access-Datenbank in eine CSV-Datei
      2. ''' Datensätze werden mit Semikolon getrennt
      3. ''' Export über Access-Funktionen nicht zufriedenstellend, daher diese "manuelle" Methode
      4. Public Sub ExportCSV(ByVal sDBFile As String, ByVal sTable As String, ByVal sExportFile As String, Optional ByVal sPassword As String = "", Optional Sortierung As String = "")
      5. 'vorhandene CSV-Datei löschen falls vorhanden
      6. Dim TextExportFile As String
      7. TextExportFile = sExportFile & ".csv"
      8. If Dir(TextExportFile) <> "" Then
      9. On Error Resume Next
      10. Kill TextExportFile
      11. On Error GoTo 0
      12. End If
      13. 'Datenbank öffnen
      14. Dim Cn As New ADODB.Connection
      15. Dim rs As New ADODB.Recordset
      16. Dim strSQL As String
      17. Cn.CursorLocation = adUseServer
      18. Cn.Provider = "Microsoft.jet.OLEDB.4.0"
      19. Cn.ConnectionString = "Data Source=" + sDBFile & ";" & "Jet OLEDB:Database Password=" & sPassword
      20. Cn.Open
      21. strSQL = "SELECT * FROM " & sTable & Sortierung
      22. rs.Open strSQL, Cn, 3, 3
      23. Set FS = CreateObject("Scripting.FileSystemObject")
      24. Set F = FS.CreateTextFile(TextExportFile, True)
      25. Dim Spaltenanzahl As Integer
      26. Dim CSVHeader As String
      27. CSVHeader = ""
      28. Spaltenanzahl = rs.Fields.Count
      29. For I = 0 To Spaltenanzahl - 1
      30. CSVHeader = CSVHeader + UCase(rs.Fields(I).name) + ";"
      31. Next I
      32. CSVHeader = Left(CSVHeader, Len(CSVHeader) - 1)
      33. 'Kompletter CSV-Inhalt
      34. Dim TextInhalt As String
      35. TextInhalt = ""
      36. 'Zeileninhalt
      37. Dim ZeilenInhalt As String
      38. 'Datensatzzähler
      39. Dim Zaehler As Integer
      40. Zaehler = 0
      41. 'Maximale Datenbankanzahl auslesen falls Datensätze existieren
      42. Dim MaxRS As String
      43. If Not rs.EOF Then
      44. rs.MoveLast
      45. MaxRS = CStr(rs.RecordCount)
      46. rs.MoveFirst
      47. End If
      48. 'Header schreiben
      49. F.WriteLine CSVHeader
      50. While Not rs.EOF
      51. ZeilenInhalt = ""
      52. For I = 0 To Spaltenanzahl - 2
      53. 'ab der ersten Spalte bis zur vorletzten Spalte Semikolon anhängen (aber in den einzelnen Datensätzen rausnehmen)
      54. ZeilenInhalt = ZeilenInhalt + Replace(CStr(rs.Fields(I) & ""), ";", "") + ";"
      55. Next I
      56. 'in der letzten Zeile kein Semikolon anhängen (aber in den einzelnen Datensätzen rausnehmen)
      57. ZeilenInhalt = ZeilenInhalt + Replace(CStr(rs.Fields(Spaltenanzahl - 1) & ""), ";", "")
      58. 'Zeilenumbrüche in Zeileninhalten entfernen
      59. ZeilenInhalt = Replace(ZeilenInhalt, vbCrLf, "")
      60. 'Zeilenumbruch nach komplettem CSV-Datensatz anhängen
      61. TextInhalt = TextInhalt + ZeilenInhalt + vbCrLf
      62. Zaehler = Zaehler + 1 'Datensatzzähler erhöhen
      63. rs.MoveNext 'nächster Datensatz in der Datenbank
      64. 'Alle 100 Datensäzte Status ausgeben (Optional)
      65. If Zaehler Mod 100 = 0 Then
      66. Label1.Caption = "Export " + CStr(Zaehler) + " von " + MaxRS
      67. DoEvents
      68. End If
      69. 'Alle 500 Datensätze in Zieldatei speichern, damit der String im Speicher nicht zu groß wird (wird sonst zu langsam)
      70. If Zaehler Mod 500 = 0 Then
      71. F.Write TextInhalt
      72. TextInhalt = ""
      73. End If
      74. Wend
      75. F.Write TextInhalt 'Restlichen Inhalt speichern
      76. F.Close
      77. rs.Close
      78. Set rs = Nothing
      79. Cn.Close
      80. Set Cn = Nothing
      81. End Sub


      Ich hoffe dieser Code kann einigen von Euch hilfreich sein.

      LG Roland
      Liebe Grüße
      Roland Berghöfer

      Meine aktuellen und kostenlos verwendbaren Tools (mit VB.NET erstellt): freeremarkabletools.com | priconman.com | SimpleCalendar | AudibleTouch | BOComponent.com | bonit.at