Excel VBA: Automatische Konvertierung von Textdatei (.txt) zu Exceldatei (.xlsx)

Hallo zusammen,

ich habe sehr viele Textdateien, die z.B. im Ordner C:\Test\txt\ abgelegt sind. Nun will ich diese Textdateien automatisch in Exceldateien umwandeln (Trennzeichen: Tab). Die Exceldateien können dann z.B. in C:\Test\xlsx\ abgelegt werden.
Ich habe dazu einen Code im Internet gefunden . Dieser erzeugt zwar die Excel-Dateien, allerdings sind die Excel-Dateien leer und haben keinen Inhalt. Könnt ihr mir sagen, wo das Problem ist oder habt ihr vielleicht einen anderen Quellcode.

Ich wäre sehr dankbar für Hilfe.

Viele Grüße

Booster

Option Explicit
 
Sub OpenWkb1()
' Öffnet alle Dateien in einem angegebenen Verzeichnis mit der vorgegeben Endung  
' Hier: Verzeichnis E:\Temp; Dateityp: *.txt  
Dim sfile As String, sPath As String
' Ausschalten der Bildschirmaktualisierung  
Application.ScreenUpdating = False
sPath = "U:\Test\txt\"  
' Überprüfung, ob das letzte Zeichen des Strings ein Backslash ist  
If Right(sPath, 1) <> "\" Then  
 sPath = sPath & "\"  
End If
' Einlesen der Vorgaben in Variable  
sfile = Dir(sPath & "*.txt")  
' Schleife, die solange arbeitet, bis die letzte Fundstelle erreich wird und die Variable leer bleibt  
Do While sfile <> ""  
 ' Aufruf der weiteren Prozedur mit der Übergabe Verzeichisn und Name  
 Call TextImport1(sPath, sfile)
 ' Einlesen des nächsten Namens  
 sfile = Dir()
Loop
' Einschalten der Bildschirmaktualisierung  
Application.ScreenUpdating = True
End Sub

Sub TextImport1(sPath As String, sfile As String)
Dim strVerzeichnis As String
Dim wkb As Workbook
' Speicherverzeichnis festlegen  
strVerzeichnis = "U:\Test\xlsx\"  
' Überprüfung, ob das letzte Zeichen des Strings ein Backslash ist  
If Right(strVerzeichnis, 1) <> "\" Then  
 strVerzeichnis = strVerzeichnis & "\"  
End If
' Ausschalten der Bildschirmaktualisierung  
Application.ScreenUpdating = False
' Neue Mappe anlegen mit der vorgegebenen Anzahl Zabellen  
Set wkb = Workbooks.Add
' Einlesen der Datei  
Workbooks.OpenText Filename:=sPath & sfile, Tab:=True, Space:=False, _
  Comma:=False, semicolon:=False, other:=False
' Speichern der Mappe  
' Systemmeldung ausschalten  
'Application.DisplayAlerts = False   ' Schaltet die Systemmeldung aus  
wkb.SaveAs Filename:=strVerzeichnis & sfile & ".xlsx"  
'Application.DisplayAlerts = True    ' Schaltet die Systemmeldung ein  
' Schließen der beiden Dateien  
wkb.Close
Workbooks(sfile).Close
Application.ScreenUpdating = True
End Sub

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 329639

Url: https://administrator.de/contentid/329639

Ausgedruckt am: 25.11.2024 um 13:11 Uhr

7 Kommentare

Neuester Kommentar

Dieser erzeugt zwar die Excel-Dateien, allerdings sind die Excel-Dateien leer und haben keinen Inhalt. Könnt ihr mir sagen, wo das Problem ist

Jepp Zeile 38-46 austauschen durch:

Workbooks.OpenText Filename:=sPath & sfile, Tab:=True, Space:=False, Comma:=False, semicolon:=False, other:=False, Datatype:=xlDelimited
'Application.DisplayAlerts = False   ' Schaltet die Systemmeldung aus   
ActiveWorkbook.SaveAs Filename:=strVerzeichnis & sfile & ".xlsx", xlOpenXMLWorkbook  

Gruß

p.s. die Suche hier im Forum liefert auch unendlich viele Skripte dazu.

Danke !

Habe ich gemacht.

Jetzt kommt aber folgende Fehlermeldung:
Laufzeitfehler 91: Objektvariable oder With-Blockvariable nicht festgelegt

Daraufhin habe ich in Zeile 49 rumprobiert, da hier diese Variable steht, aber hat nichts gebracht leider...

Was müsste ich ändern?

Sorry vergessen
Zeile 49 und 50 noch durch

ActiveWorkbook.Close

ersetzen.
Jetzt sollte dir aber spätestens klar sein was derjenige falsch gemacht hat ... Er hat ein leeres Workbook gespeichert was er in Zeile39 erzeugt hat und nicht das Workbook das durch OpenText geöffnet wurde.

Bitte ab und zu auch mal ins Handbuch schauen anstatt zu rätseln ... Wozu gibt es wohl die Debugging-Funktion?!

Super, danke!

Jetzt werden die Dateien erstellt.

Beim Abspeichern sieht man aber bereits, dass die Dateien immer noch leer sind.

Wenn die Dateien abgespeichert sind, lassen sie sich auch nicht mehr öffnen (Fehlermeldung: "Dateiformat oder Dateierweiterung ungültig").

Sorry, ich will Dir echt nicht zu viele Umstände machen. Aber wäre super, wenn Du eine Lösung weißt.

VG

Dann hast du entweder einen Fehler beim kopieren eingebaut oder deine Dateien sind fehlerhaft.
Hast du wirklich den Parameter xlOpenXMLWorkbook in der SaveAs Zeile am Ende stehen?

Geht hier im Test ohne Fehler.

Ich finde leider keines dieser Skripte. Wenn Du ein Skript dazu gesehen hast, wäre es super, wenn du es mir schicken könntest.

Ich finde nur Skripte für abgewandelte Anwendungen (z.B. nur bestimmte Bereiche der txt auslesen, nur eine txt auslesen etc). Leider habe ich es nicht hinbekommen, die Skripte so zu ändern, dass was sinnvolles dabei rauskommt.

Ja funktioniert leider nicht. Keine Ahnung, was falsch läuft...

Trotzdem danke für Deine Hilfe!

Ich konnte jetzt ein anderes Skript finden, das funktioniert.

  
Sub TXTconvertXLS()

    'Variables  
    Dim wb As Workbook
    Dim strFile As String
    Dim strDir As String

    'Directories  
    strDir = "U:\02_MA_Nachmessungen\03_Raman\Test\"  
    strFile = Dir(strDir & "*.txt")  

    'Loop  
    Do While strFile <> ""  
        Set wb = Workbooks.Open(strDir & strFile)
            With wb
                .SaveAs Replace(wb.FullName, ".txt", ".xlsx"), 50  
                .Close False   '<-already saved in the line directly above  
            End With
        Set wb = Nothing
        strFile = Dir   '<- stuffs the next filename into strFile  
    Loop


    End Sub