AW: Tabellen einer Arbeitsmappe als Txt speichern
27.02.2016 20:22:06
fcs
Hallo Jaylan,
hier eine Langversion für das Speichern als Textdatei.
In der aufrufenden Codezeile für die Function musst du ggf. entsprechend den Hinweisen für die Function die Parameter anpassen (auf jeden Fall das Verzeichnis!)
Gruß
Franz
Sub Tabellen_als_Text_speichern()
Dim wkb_Q As Workbook, wks_Q As Worksheet, bolOK As Boolean
Set wkb_Q = ActiveWorkbook
Application.ScreenUpdating = False
'Alle Tabellenblatt in der Arbeitsmappe als Text-Datei speichern
For Each wks_Q In wkb_Q.Worksheets
Application.StatusBar = wks_Q.Index & ". Blatt von " _
& wkb_Q.Worksheets.Count & " Wird gespeichert"
bolOK = fncSave_as_Text( _
strPfad:="C:\Users\Public\Test\", _
wks:=wks_Q, _
lngFileFormat:=23, _
bolRename:=True) 'Parameter ggf. anpassen
If Not bolOK Then
MsgBox "Makro wird wegen Fehler abgebrochen", _
vbOKOnly, "Speichern als Text-Datei"
Exit For
End If
Next
Application.ScreenUpdating = True
Application.StatusBar = False
If bolOK Then
MsgBox "Fertig!", vbInformation + vbOKOnly, "Speichern als Text-Datei"
End If
End Sub
Function fncSave_as_Text(strPfad As String, wks As Worksheet, _
lngFileFormat As Long, _
Optional bolRename As Boolean = False, _
Optional bolLocal As Boolean = True) As Boolean
'strPfad = Speicherpfad für Text-Dateien
'wks = Tabelenblatt, das als Text/CSV gespeichert werden soll
'lngFileFormat = Text/CSV-Format in dem das Tabellenblatt gespeichert werden soll
'VBA-Konstane Wert Beschreibung / Trennzeichen
'xlCurrentPlatformText -4158 Current Platform Text / TAB
'xlTextMac 19 Macintosh Text / TAB
'xlTextMSDOS 21 MSDOS Text / TAB
'xlTextPrinter 36 Printer Text / füllende Leerzeichen
'xlTextWindows 20 Windows Text / TAB
'xlUnicodeText 42 Unicode Text / TAB
'Trennzeichen bei CSV-Formaten gemäß Parameter Local
'xlCSV 6 CSV
'xlCSVMac 22 Macintosh CSV
'xlCSVMSDOS 24 MSDOS CSV
'xlCSVWindows 23 Windows CSV
'bolLocal = Legt fest, welche Trennzeichen und Zahlen-/Datumsformate _
in die txt-/csv-Datei geschrieben werden.
'True = gemäß Länder-Einstellungen in Systemsteuerung
'False = gemäß Einstellungen USA
'Trennzeichen = Komma
'Zahlen mit Punkt als Dezimalzeichen
'Datumsformat = M/T/JJJJ
'bolRename = kann bei CSV-Formaten auf True gesetzt werden, wenn die _
Erweiterung des Dateinamens von "csv" in "txt" geändert werden soll
Dim wkb_Txt As Workbook
Dim strExt As String
On Error GoTo Fehler
Select Case lngFileFormat
Case -4158, 18, 20, 21, 36, 42 'Text-Formate
strExt = ".txt"
Case 6, 22, 23, 24 'CSV-Formate
strExt = ".csv"
Case Else
fncSave_as_Text = False
MsgBox "unzulässige Textdatei-Format Nr.: " & lngFileFormat, _
vbOKOnly, "Speichern als Textdatei"
GoTo Fehler
End Select
'Tabellenblatt kopieren in neue Mappe
wks.Copy
Set wkb_Txt = ActiveWorkbook
Application.DisplayAlerts = False
wkb_Txt.SaveAs _
Filename:=strPfad & wks.Name & strExt, _
FileFormat:=lngFileFormat, _
Local:=bolLocal
wkb_Txt.Close savechanges:=False
Set wkb_Txt = Nothing
Application.DisplayAlerts = True
If bolRename = True Then
If Dir(strPfad & wks.Name & ".txt") "" Then
VBA.Kill strPfad & wks.Name & ".txt"
End If
Name strPfad & wks.Name & strExt As strPfad & wks.Name & ".txt"
End If
fncSave_as_Text = True
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
If Not wkb_Txt Is Nothing Then
wkb_Txt.Close savechanges:=False
End If
End Select
End With
End Function