Hey an alle VBA Profis,

Habe ein kleines Problem an dem ich am Verzweifeln bin. Ich hoffe ihr könnt mir weiterhelfen.

Problemstellung:

Ich habe über 1000 *.mdb Dateien, die ich verändern muss und als DBF IV abspeichern. In jeder *.mdb Datei müssen die Spalten B und C als Text mit 20 Zeichen dargestellt werden.

Da Excel 2007 nicht das Abspeichern als DBF erlaubt, habe ich mir ein Add-in „ExceltoDBF“ heruntergeladen und installiert. Dieses Add-in funktiert einwandfrei. Ich öffne die *.mdb Datei mit Excel 2007. Dann speicher ich es als DBF ab. Vor dem Speichern kann ich die Felder/Spalten modifizieren (Char/Numberic) sowie die Zeichenanzahl angeben.

Da ich es ja von Hand für eine Datei machen kann, habe ich mir gedacht, dass das auch per VBA funktioniert.

Also kann ich zwar nun die Datei öffnen aber beim speichern gibt es probleme und ich weis auch nicht wie ich die Spalte B und C als Text mit 20 Zeichen angeben kann. Da muss es doch irgendwas geben, oder? (.field „xyz“ as Char) oder so...

Hier mein Code:

„Microsoft DAO 3.6 Object Library“ und „Microsoft Access 12.0 Object Library“ sind aktiv.

Dim ws As Workspace, row As Integer, col As Integer
Dim db As Object, rs As Recordset
Dim access_db As String

Workbooks.Add

ActiveSheet.Cells(1, 1).Value = "Überschrift 01"
ActiveSheet.Cells(1, 2).Value = "Überschrift 02"
ActiveSheet.Cells(1, 3).Value = "Überschrift 03"
ActiveSheet.Cells(1, 4).Value = "Überschrift 04"
ActiveSheet.Cells(1, 5).Value = "Überschrift 05"
ActiveSheet.Cells(1, 6).Value = "Überschrift 06"
ActiveSheet.Cells(1, 7).Value = "Überschrift 07"
ActiveSheet.Cells(1, 8).Value = "Überschrift 08"
ActiveSheet.Cells(1, 9).Value = "Überschrift 09"
ActiveSheet.Cells(1, 10).Value = "Überschrift 10"
ActiveSheet.Cells(1, 11).Value = "Überschrift 11"
ActiveSheet.Cells(1, 12).Value = "Überschrift 12"
ActiveSheet.Cells(1, 13).Value = "Überschrift 13"
ActiveSheet.Cells(1, 14).Value = "Überschrift 14"
ActiveSheet.Cells(1, 15).Value = "Überschrift 15"
ActiveSheet.Cells(1, 16).Value = "Überschrift 16"
ActiveSheet.Cells(1, 17).Value = "Überschrift 17"

access_db = "Beispiel.mdb"

Set db = OpenDatabase(access_db)
Set rs = db.OpenRecordset("select * from TABLE")
row = 0
ActiveSheet.Range("A2").CopyFromRecordset rs
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing



      Application.DisplayAlerts = False
      ActiveWorkbook.SaveAs "C:/Test/Beispiel.dbf", FileFormat:=xlDBF4 'LAUFZEITFEHLER!!!!
      ActiveWorkbook.Close
      Application.DisplayAlerts = True

Ich hoffe jemand kennt sich hiermit aus oder hatte schon mal ein ähnliches Problem.

Ben