AW: .txt mit VBA in Tabelle importieren "UPDATE"
30.05.2024 19:54:27
DerWolle
Ich habe jetzt einen Code gefunden der auch sehr gut das abdeckt was ich möchte. Nur werden das ÄÜü usw nicht richtig dargestellt. Ich müsste wohl den UniCode einstellen, aber weiß nicht wie das geht in dem Code. Jemand eine Lösung für mich?
Sub TXT_Import()
Dim xFilesToOpen As Variant
Dim xFile As Variant
Dim xWb As Workbook
Dim xTempWb As Workbook
Dim xDelimiter As String
Dim xScreen As Boolean
On Error GoTo ErrHandler
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
'Ziel-Datei suchen/Setzen
Set xWb = ActiveWorkbook
GoTo Weiter1
'Alternative zur Bestimmung der Ziel-Datei
For Each xWb In Application.Workbooks
If xWb.Worksheets(1).Name = "Ursprungsdaten" Then Exit For
Next
If xWb Is Nothing Then
MsgBox "Es ist keien Arbeitsmappe mit dem Blatt ""Ursprungsdaten"" geöffnet", vbOKOnly
Exit Sub
GoTo ExitHandler
End If
Weiter1:
'Textdateien auswählen
xDelimiter = "|"
xFilesToOpen = Application.GetOpenFilename(Filefilter:="Text Files (*.txt), *.txt", _
Title:="TXT Dateien auswählen ", MultiSelect:=True)
If TypeName(xFilesToOpen) = "Boolean" Then
MsgBox "Es wurden keine TXT Dateien ausgewählt!", vbCritical, "Error!"
GoTo ExitHandler
End If
'Textdateien abarbeiten
For Each xFile In xFilesToOpen
'Texdatei schreibgeschützt öffnen und aufbereiten
Set xTempWb = Workbooks.Open(xFile, ReadOnly:=True)
xTempWb.Worksheets(1).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=False, OtherChar:=xDelimiter
'aufbereitetes Tabellenblatt in Zieldatei kopieren
With xWb
xTempWb.Sheets(1).Copy After:=.Sheets(.Sheets.Count)
End With
'Textdatei ohne speichern schliessen
xTempWb.Close False
Set xTempWb = Nothing
Next xFile
ExitHandler:
Application.ScreenUpdating = xScreen
Set xWb = Nothing
Exit Sub
ErrHandler:
MsgBox "Fehler-Nr.: " & Err.Number & vbLf & Err.Description, , "Error!"
Resume ExitHandler
End Sub