Excel zu TXT exportieren
02.01.2020 16:56:55
Manfred
Problem: Ich hab eine Exceltabelle mit Namen, Adressen und Telefonnummern. Für einen Import in ein andres Programm benötige ich eine txt Datei bei dem die einzelnen Zellen mit Anführungszeichen versehen sind und durch einen Beistrich (NICHT Stichpunkt) getrennt sind.
Die Excel sieht zB so aus:
A1: Muster Max
B1: Hauptplatz 1
C1: 8010
D1: AUT
E1 0
F1: 0316 123456
G1: 0
H1: 0664 123456
In der Text Datei soll es dann so aussehen:
"Muster Max","Hauptplatz 1","8010","AUT","","031528305","","0664123456"
Ich hab da schon folgendes Makro gefunden das zwar alles genau so macht nur leider ist die Trennung mit Strichpunkt und nicht wie gewünscht mit einen Beistrich. Ich weis aber nicht wo ich beim Makro was umstellen muss.
Sub CSVFile()
'updateby Extendoffice 20160530
Dim xRg As Range
Dim xRow As Range
Dim xCell As Range
Dim xStr As String
Dim xSep As String
Dim xTxt As String
Dim xName As Variant
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("Please select the data range:", "Kutools for Excel", xTxt, , _
, , , 8)
If xRg Is Nothing Then Exit Sub
xName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")
xSep = Application.International(xlListSeparator)
Open xName For Output As #1
For Each xRow In xRg.Rows
xStr = ""
For Each xCell In xRow.Cells
xStr = xStr & """" & xCell.Value & """" & xSep
Next
While Right(xStr, 1) = xSep
xStr = Left(xStr, Len(xStr) - 1)
Wend
Print #1, xStr
Next
Close #1
If Err = 0 Then MsgBox "The file has saved to: " & xName, vbInformation, "Kutools for Excel" _
End Sub