AW: xlcsv
28.11.2005 08:51:29
=Peter=
Hallo Marko,
eine Möglichkeit:
Sub SaveCSV()
'Quelle: Thomas Ramel
<a href="'http://phorum.excelhost.de/read.php?11,74296,74296#msg-74296">'http://phorum.excelhost.de/read.php?11,74296,74296#msg-74296</a>
Dim Bereich As Object
Dim Zeile As Object
Dim Zelle As Object
Dim strTemp As String
Const Pfad As String = "C:\Test\"
Const Dateiname As String = "test"
Const Extension As String = ".CSV"
Const Trennzeichen As String = ";"
Const Kapselzeichen As String = """"
'Hier kann auch ein eigener Range angegeben werden
Set Bereich = ActiveSheet.UsedRange
Open Pfad & Dateiname & Extension For Output As #1
For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
If InStr(1, Zelle.Text, Trennzeichen) > 0 Then 'angepasst T.Ramel
'Zellen, die ein Trennzeichen beinhalten in Kapselzeichen setzen
strTemp = strTemp & Kapselzeichen & CStr(Zelle.Text) & _
Kapselzeichen & Trennzeichen
Else
strTemp = strTemp & CStr(Zelle.Text) & Trennzeichen
End If
Next
strTemp = Left(strTemp, Len(strTemp) - 1) 'angepasst T.Ramel
Print #1, strTemp
strTemp = ""
Next
Close #1
Set Bereich = Nothing
End Sub
HTH
Gruss
Peter