Thema: xls in Format .txt per VBA konvertieren | Herbers Excel-Forum

Liebe Excel-Gemeinde,
ich bitte um Eure geschätzte Hilfe.
Problem:
ich extrahiere aus einer Forecast-Datei per Makro ein einzelnes Tabellenblatt, das die Kosten je Konto und Periode für einen Upload zu SAP bereitstellt. Das Format ist xls. Jetzt benötigt SAP aber das Format "Text (Tabstopp getrennt)(.txt)". Bis dato muss ich das als xls gespeicherte Blatt wieder aufrufen und dann als txt speichern. Und diese Arbeit würde ich gerne automatisieren.
Nachstehend der Code für das Erzeugen der xls.-Datei und auch die Datei mit dem relevanten Blatt und Makro.
https://www.herber.de/bbs/user/67057.xls
Dim strFile As String, wbQuelle As Workbook, wbZiel As Workbook
Dim wksQuelle As Worksheet, wksZiel As Worksheet, zelle As Range
Dim iClick As Integer
strFile = Sheets("Upload-File Monatswerte").Range("C3") & " FC Kosten Upload Monatswerte" 'Dateinamen vorgeben!
strFile = Application.GetSaveAsFilename(InitialFileName:=strFile, _
fileFilter:="Excel Files (*.xls; *.xla; *.xlt), *.xls; *.xla; *.xlt")
If strFile = "Falsch" Then Exit Sub
Set wbQuelle = ActiveWorkbook 'Workbooks("Master FC mit Upload-Exportfunktion.xls") '
Set wksQuelle = wbQuelle.Sheets("Upload-File Monatswerte")
wksQuelle.Copy
Set wbZiel = ActiveWorkbook
Set wksZiel = wbZiel.Worksheets(1)
With wksZiel
'Alles Inhalte durch Werte ersetzen
.UsedRange.Value = .UsedRange.Value
'Spalten ab Spalte Q (18) löschen
.Range(.Columns(17), .Columns(.Columns.Count)).Delete Shift:=xlShiftToLeft
'Zeile 1 (Überschriften Exportdatei (nicht Ursprungsdatei !!) ) löschen
Rows("1:2").Select
Selection.Delete Shift:=xlUp
'anschließend in der Upload-Tabelle alles ab Zeile 36 löschen
.Range(.Rows(36), .Rows(.Rows.Count)).Delete Shift:=xlShiftUp
'Makrobutton, Textbox und Summenwerte löschen
ActiveSheet.Shapes("Button 1").Select
Selection.Delete
Range("P37").Select
Selection.AutoFill Destination:=Range("P37:P40"), Type:=xlFillDefault
Range("A1").Select
'Name ändern
.Name = "Upload-Datei Kosten"
'Alle Zahlen im Upload-Bereich auf 2 Stellen runden
For Each zelle In .Range("A1:P35")
If IsNumeric(zelle) Then
zelle.Value = Application.WorksheetFunction.Round(zelle.Value, 2)
End If
Next
End With
'Konto mit der führenden Null versehen
Range("D35").Select
ActiveCell.FormulaR1C1 = "'08990000"
Range("E1").Select
With wbZiel
.SaveAs strFile
.Close 'wenn die neue Mappe geschlossen werden soll!
End With
Call Upload_File_Mitarbeiter
End Sub
Danke Euch im voraus
Grüße, Bernd

Sorry, der VBA-Code war leider nicht entsperrt.
hier entsperrt: https://www.herber.de/bbs/user/67058.xls
Grüße
Bernd

Hi
du kannst auch per Makro eine Datei als Textfile speichern.
wenn du wissen willst, wie das geht, lass einfach mal den Makrorecorder beim Speichern mitlaufen.
mehr kann ich dazu jetzt nicht sagen, aber wenn du hier ne Datei hochläst, dann solltest du den Schutz vorher rausnehmen oder das Kennwort mitschicken.
Gruß, Daniel

Hallo Daniel,
ich hatte ein paar Minuten später die entsperrte Datei hochgeladen. https://www.herber.de/bbs/user/67058.xls
Wahrscheinlich hat sich das mit Deiner Antwort überschnitten.
Willst du mal reinschau'n?
Danke, Bernd

Hi
jo, kann ich, ändert aber nichts an meiner Antwort.
Die Lösung kannst du leicht mit dem Makrorekorder oder der VBA-Hilfe rausfinden, dafür sind die da.
Gruß, Daniel

ich habe es wirklich (!!!!) bis jetzt 24 h versucht, auch mit Marorecorder und vba-hilfe... Es klappt nicht.
Bitte helfe mir doch, Danel.
Danke, Bernd

Ich habe den Tipp von Daniel mit dem Makrorekoreder versucht. Das bringt's auch nicht.
das wird aufgezeichnet:
' Sheets("Upload-File Monatswerte").Copy
' ActiveWorkbook.SaveAs Filename:= _
' "D:\Tabstopp-getrennt 22.35 h.txt" _
' , FileFormat:=xlText, CreateBackup:=False
'Codeversuch analog VBA-Hilfe (kommt Quatsch)
strFile = Application.GetSaveAsFilename(InitialFileName:=strFile, _
fileFilter:="Text Files (*.txt), *.txt")
'xls-Code, funktioniert
' strFile = Application.GetSaveAsFilename(InitialFileName:=strFile, _
' fileFilter:="Excel Files (*.xls; *.xla; *.xlt), *.xls; *.xla; *.xlt")
Will mir denn keiner den entscheidenden Tipp geben?
https://www.herber.de/bbs/user/67063.xls
Grüße
Bernd

und was hat jetzt GetSaveAs-Filename mit SaveAs zu tun?
du musst, daß was du bei SaveAs aufgezeichnet hast, auch in dein Makro bei SaveAs einfügen (nämlich das mit dem FileFormat)
das GesSaveAs gibt dir ja nur einen String zurück (den soltest du dir vorher nochmal anschauen und ggf die Dateierweiterung entfernen, den die wird von Excel beim Speichern automatisch angehängt)
Gruß, Daniel

Hallo Daniel,
mal so ins Blaue geschossen. Eventuell hilft es:
ActiveWorkbook.SaveAs Filename:= strFile_
, FileFormat:=xlText, CreateBackup:=False
strFile muss du natürlich vorher definieren.
Gruß
welga

Hallo nochmals,
versuch es mal so:

Sub xlszutxt()
Dim lngCount As Integer                     ' Dateizähler
Dim varDateiname As Variant                 ' Dateiplatzhalter
Dim Suchpfad As String, Dateiform As String, Speicherpfad As String, Datname As String
Dim totFiles As Long
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Suchpfad  _
definieren", "C:\Dokumente und Einstellungen\Administrator\Desktop\sap-xls") 'Hier anpassen
If Suchpfad = "" Then Exit Sub
Dateiform = InputBox("Bitte die Endung der Dateiform definieren", "Dateierweiterung", "xls") _
If Dateiform = "" Then Exit Sub
Speicherpfad = InputBox("Geben Sie den Ordner an, in welchem gespeichert werden soll.", " _
Speicherfad definieren", "C:\Dokumente und Einstellungen\Administrator\Desktop\sap-txt") 'Hier anpassen
If Speicherpfad = "" Then Exit Sub
With Application.FileSearch
.LookIn = Suchpfad
.SearchSubFolders = True
.Filename = Dateiform
If .Execute() > 0 Then
totFiles = .FoundFiles.Count
' Bildschirmaktualisierung und Alarm deaktivieren
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' Ausgewählte Dateien öffnen
For lngCount = 1 To totFiles '          ' Anzahl der Dateien
varDateiname = .FoundFiles(lngCount)
If varDateiname <> False Then                   ' Test auf gültigen Dateinamen
' xls-Dateien öffnen
Workbooks.OpenText Filename:=varDateiname, Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True,  _
_
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1),  _
_
Array(2, 1)), local:=True
Datname = Dir(varDateiname)
Datname = Left(Datname, InStr(3, StrReverse(Datname), ".") - 3) 'Dateinamen  _
erkennen und speichern
ActiveWorkbook.SaveAs Speicherpfad & "\" & Datname, FileFormat:=xlText,  _
CreateBackup:=False
' Aktuell geöffnete xls-Datei schließen
ActiveWorkbook.Close
End If
Next lngCount
End If
End With
End Sub

Gruß
welga

HalloWelga, klappt auch nicht.
Ich werde einen neuen Beitrag aufmachen in der Hoffnung, doch noch die Lösung zu erhalten, auch wenn ich mir damit sicherlich Unmut einfange...
das ist nach wie vor das Problem:
'dieser Code erzeugt leider keine 'sauberen' Nullen in Exporttab. sondern Unsinn
strFile = Application.GetSaveAsFilename(InitialFileName:=strFile, _
fileFilter:="Text (Tabstopp-getrennt)Files (*.txt), *.txt")
Deinen Code habe ich in Modul 3 eingebaut: https://www.herber.de/bbs/user/67072.xls
Grüße, Bernd

Jetzt habe ich es doch noch hinbekommen. Die dritte Zeile unten musste am Ende des Codes eingefügt werden:
...
With wbZiel
.SaveAs strFile, _
FileFormat:=xlText, CreateBackup:=False 'Zeile neu aufgenommen f. tabstopp getrennt
.Close
End With
Grüße, Bernd