Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1580to1584
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Automatisierungssequenz zum Einlesen von txt-Files

Automatisierungssequenz zum Einlesen von txt-Files
27.09.2017 20:05:53
txt-Files
Hallo zusammen,
ich tüftle aktuell an einem VBA-Skript, welches automatisiert Textdateien in Excel importiert, über diese dann eine Kopfzeile setzt und sie anschließend als xlsx-Datei in einem fest definierten Ordner abspeichert.
Soweit so gut, die Basis steht bereits und das Importieren der txt-Files funktioniert problemlos und genauso wie es gedacht ist.
Leider hänge ich aktuell am automatischen Abspeichern sowie dem Einfügen der Kopfzeile. Somit wende ich mich nun hilfesuchend an die Experten in diesem Forum :-)
Bisher sieht mein Code wie folgt aus:
Option Explicit
Sub TXT_Einlesen()
'Variablen deklarieren
Dim CurrentFileName As String, InputFolder As String
'Ausschalten der Bildschirmaktualisierung
Application.ScreenUpdating = False
'Angabe des Input-Verzeichnisses
InputFolder = ActiveWorkbook.Path & "\Input\"
'Überprüfung, ob das letzte Zeichen des Strings ein Backslash ist
If Right(InputFolder, 1)  "\" Then
InputFolder = InputFolder & "\"
End If
'Einlesen aller im Input-Verzeichnis vorhandenen TXT-Files
CurrentFileName = Dir(InputFolder & "*.txt")
'Einlese-Schleife
Do While CurrentFileName  ""
Call TextImportStart(InputFolder, CurrentFileName)
CurrentFileName = Dir()
Loop
'Einschalten der Bildschirmaktualisierung
Application.ScreenUpdating = True
End Sub
Sub TextImportStart(InputFolder As String, CurrentFileName As String)
'Variablen deklarieren
Dim OutputFolder As String
Dim wbk As Workbook
'Angabe des Output-Ordners
OutputFolder = ActiveWorkbook.Path
'Überprüfung, ob das letzte Zeichen des Strings ein Backslash ist
If Right(OutputFolder, 1)  "\" Then
OutputFolder = OutputFolder & "\"
End If
'Ausschalten der Bildschirmaktualisierung
Application.ScreenUpdating = False
'Einlesen der Datei, Trennzeichen = |
Workbooks.OpenText Filename:=InputFolder & CurrentFileName, Tab:=False, Space:=False, Comma:= _
False, Semicolon:=False, Other:=True, OtherChar:="|"
'Systemmeldungen deaktivieren
Application.DisplayAlerts = False
'Mappen speichern - KLAPPT NOCH NICHT!!!
'wbk.SaveAs Filename:=OutputFolder & CurrentFileName & ".xls"
'Systemmeldungen einschalten
Application.DisplayAlerts = True
'Schließen der Dateien
For Each wkb In Workbooks
If Not wkb.Name = Application.ThisWorkbook.Name Then wkb.Close True
Next
'Einschalten der Bildschirmaktualisierung
Application.ScreenUpdating = True
End Sub

Nun meine Fragen: Was muss ich anpassen, damit ein automatisches Speichern der Dateien funktioniert? Bisher wird nur die erste Datei gespeichert, daraufhin bricht das Skript ab und meldet, dass eine Datei mit dem gleichen Namen bereits vorhanden wäre. Ich vermute also, dass das Skript alle Dateien unter dem gleichen Namen speichern will, eigentlich hätte ich aber gerne, dass es jede Datei unter dem jeweiligen Namen der Arbeitsmappe, welcher ja von der Importdatei mit eingelesen wird, abspeichert.
Beispiel: Datei 1 heißt 1.txt und wird unter eben diesem Namen eingelesen. Das Skript sollte die Datei dann als 1.xlsx speichern. Gleiches mit den Folgedateien.
Ein weiterer Haken wäre eine automatische Platzierung einer festen Kopfzeile in jede der eingelesenen Dateien.
Beispiel: Datei 1.txt wird eingelesen, der Import der Informationen aus der txt sollte bei Zeile 2 beginnen und in Zeile 1 sollte immer die feste Kopfzeile eingefügt werden (A1 = "Spalte1", B1 = "Spalte2", C1= "Spalte3", D1 = "Spalte4", E1 = "Spalte5"). Dies sind aktuell nur Platzhalternamen, welche ich aber später entsprechend anpassen würde. Meine Versuche scheiterten daran, dass die Kopfzeile immer nur in der ersten Datei eingefügt wurde, danach war leider Schluss. Ich vermute ich muss das ebenfalls irgendwie in eine Schleife einbauen?!
Leider bin ich nicht der größte VBA-Profi, lerne aber gerne stetig dazu. Ohne Hilfe von Profis stehe ich aber leider gerade auf dem Schlauch :-(
Ich hoffe mir kann jemand weiterhelfen. Ich danke schon einmal vorab!
Viele Grüße,
MFZB159

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Automatisierungssequenz zum Einlesen von txt-Files
27.09.2017 20:32:38
txt-Files
Hallo,
wenn Du
'wbk.SaveAs Filename:=OutputFolder & CurrentFileName & ".xls"
ersetzt durch
Activeworkbook.SaveAs Filename:=OutputFolder & CurrentFileName & ".xlsx"
und den Aufruf von Textimport in
Call TextImportStart(InputFolder, left(CurrentFileName,len(Currentfilename)-4))
'dadurch wird .txt entfernt
änderst, sollte es eigentlich gehen...
Gruß der AlteDresdner
AW: Automatisierungssequenz zum Einlesen von txt-Files
27.09.2017 20:32:59
txt-Files
Hallo ?,
ungetestet!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub TXT_Einlesen()

'Variablen deklarieren
Dim CurrentFileName As String, InputFolder As String

'Ausschalten der Bildschirmaktualisierung
Application.ScreenUpdating = False

'Systemmeldungen deaktivieren
Application.DisplayAlerts = False

'Angabe des Input-Verzeichnisses
InputFolder = ActiveWorkbook.Path & "\Input\"

'Überprüfung, ob das letzte Zeichen des Strings ein Backslash ist
If Right(InputFolder, 1) <> "\" Then
  InputFolder = InputFolder & "\"
End If

'Einlesen aller im Input-Verzeichnis vorhandenen TXT-Files
CurrentFileName = Dir(InputFolder & "*.txt")

'Einlese-Schleife
Do While CurrentFileName <> ""
  Call TextImportStart(InputFolder, CurrentFileName)
  CurrentFileName = Dir()
Loop

'Einschalten der Bildschirmaktualisierung
Application.ScreenUpdating = True

'Systemmeldungen einschalten
Application.DisplayAlerts = True

End Sub

Sub TextImportStart(InputFolder As String, CurrentFileName As String)
'Variablen deklarieren
Dim OutputFolder As String
Dim objWorkBook As Workbook, varHeaders As Variant, strFilename As String

varHeaders = Array("Spalte1", "Spalte2", "Spalte3", "Spalte4", "Spalte5")

strFilename = Left(CurrentFileName, InStrRev(CurrentFileName, ".")) & "xls"

'Angabe des Output-Ordners
OutputFolder = ActiveWorkbook.Path

'Überprüfung, ob das letzte Zeichen des Strings ein Backslash ist
If Right(OutputFolder, 1) <> "\" Then
  OutputFolder = OutputFolder & "\"
End If

'Einlesen der Datei, Trennzeichen = |
Workbooks.OpenText Filename:=InputFolder & CurrentFileName, Tab:=False, Space:=False, Comma:= _
  False, Semicolon:=False, Other:=True, OtherChar:="|"

Set objWorkBook = Workbooks(CurrentFileName)

'Mappen speichern - KLAPPT NOCH NICHT!!!
With objWorkBook
  With .Sheets(1)
    .Rows(1).Insert
    .Cells(1, 1).Resize(1, UBound(varHeaders) + 1) = _
      Application.Transpose(Application.Transpose(varHeaders))
  End With
  .SaveAs Filename:=OutputFolder & strFilename, FileFormat:=56
  .Close True
End With

End Sub

Gruß Sepp

Anzeige
AW: Automatisierungssequenz zum Einlesen von txt-Files
27.09.2017 21:19:50
txt-Files
Hallo Sepp,
diese Zeile:

.Cells(1, 1).Resize(1, UBound(varHeaders) + 1) = _
Application.Transpose(Application.Transpose(varHeaders))
klappt bei mir auch so:
.Cells(1, 1).Resize(1, UBound(varHeaders) + 1) = varHeaders
Gruß von Luschi
aus klein-Paris
Stümmt natürlich ;-) Dank! o.T.
27.09.2017 21:27:59
Sepp
Gruß Sepp

AW: Automatisierungssequenz zum Einlesen von txt-Files
27.09.2017 21:42:04
txt-Files
Hallo zusammen,
vielen lieben Dank für die schnellen Antworten!
Der erste Lösungsansatz von AlterDresdner hat perfekt funktioniert :-)
Beim Speichern musste ich nur noch zuweisen, dass es eine Excelmappe sein soll, denn sonst wurden die Files fälschlicherweise als TXT mit Endung xlsx gespeichert und ließen sich nicht mehr öffnen.
Nun funktioniert aber alles soweit.
Ich hätte noch eine letzte kleine Frage: Die Dateien landen nun im Hauptverzeichnis neben der xlsm-Datei. Ich hätte den Export gerne noch in einen Output-Ordner.
Habe es mal so versucht, aber irgendwie verkettet sich das Ganze ein wenig:
OutputFolder = ActiveWorkbook.Path & "\Output\"

Hier funktioniert es bei der ersten Datei, diese landet in /Output, bei der nächsten versucht er dann aber in /Output/Output zu speichern, bricht aber ab, da der Ordner nicht existiert.
Ein weiterer Versuch war dieser:
ActiveWorkbook.SaveAs Filename:=OutputFolder & "\Output\ & CurrentFileName & ".xlsx", FileFormat:=xlWorkbookDefault

Aber auch hier ein Fehler, der mir sagt der Dateiname wäre zu lang...
Weiß jemand Abhilfe? Vielen Dank vorab!
Gruß,
MFZB159
Anzeige
AW: Automatisierungssequenz zum Einlesen von txt-Files
27.09.2017 21:46:47
txt-Files
Hallo ?,
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub TXT_Einlesen()
'Variablen deklarieren
Dim CurrentFileName As String, InputFolder As String, OutputFolder As String

'Ausschalten der Bildschirmaktualisierung
Application.ScreenUpdating = False

'Systemmeldungen deaktivieren
Application.DisplayAlerts = False

'Angabe des Input-Verzeichnisses
InputFolder = ActiveWorkbook.Path & "\Input\"

'Angabe des Output-Verzeichnisses
OutputFolder = ActiveWorkbook.Path & "\Output\"

'Überprüfung, ob das letzte Zeichen des Strings ein Backslash ist
If Right(InputFolder, 1) <> "\" Then
  InputFolder = InputFolder & "\"
End If

'Überprüfung, ob das letzte Zeichen des Strings ein Backslash ist
If Right(OutputFolder, 1) <> "\" Then
  OutputFolder = OutputFolder & "\"
End If

'Einlesen aller im Input-Verzeichnis vorhandenen TXT-Files
CurrentFileName = Dir(InputFolder & "*.txt")

'Einlese-Schleife
Do While CurrentFileName <> ""
  Call TextImportStart(InputFolder, OutputFolder, CurrentFileName)
  CurrentFileName = Dir()
Loop

'Einschalten der Bildschirmaktualisierung
Application.ScreenUpdating = True

'Systemmeldungen einschalten
Application.DisplayAlerts = True

End Sub

Sub TextImportStart(InputFolder As String, OutputFolder As String, CurrentFileName As String)
'Variablen deklarieren
Dim OutputFolder As String
Dim objWorkBook As Workbook, varHeaders As Variant, strFilename As String

varHeaders = Array("Spalte1", "Spalte2", "Spalte3", "Spalte4", "Spalte5")

strFilename = Left(CurrentFileName, InStrRev(CurrentFileName, ".")) & "xls"

'Einlesen der Datei, Trennzeichen = |
Workbooks.OpenText Filename:=InputFolder & CurrentFileName, Tab:=False, Space:=False, Comma:= _
  False, Semicolon:=False, Other:=True, OtherChar:="|"

Set objWorkBook = Workbooks(CurrentFileName)

'Mappen speichern - KLAPPT NOCH NICHT!!!
With objWorkBook
  With .Sheets(1)
    .Rows(1).Insert
    .Cells(1, 1).Resize(1, UBound(varHeaders) + 1) = varHeaders
  End With
  .SaveAs Filename:=OutputFolder & strFilename, FileFormat:=56
  .Close True
End With

End Sub

Gruß Sepp

Anzeige
AW: Automatisierungssequenz zum Einlesen von txt-Files
28.09.2017 17:59:32
txt-Files
Dankeschön! Klappt wunderbar! :-)

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige