Probleme beim CSV speichern per Makro

22/08/2007 - 20:32 von Sascha W. | Report spam
Hallo zusammen,

ich weiß bereits durch andere threads, dass ich Local:=True verwenden soll,
um ein Semikolon getrenntes CSV zu erhalten. Habe nur das Problem, dass ich
Kollegen habe, die keine deutsche Version benutzen und deshalb Local:=True
mich nicht weiterbringt.

Mein Code ist folgender:

Sub
datDate = Date
Arbeitsmappe_Pfad = ActiveWorkbook.Path
Dim s As Single
s = Timer
Application.ScreenUpdating = False
Sheets("a").Select
Columns("A:W").Select
Selection.Copy
Sheets("b").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select
Rows("1:2").Delete
Columns("A:W").Select
Selection.Copy
Application.Workbooks.Add
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=Arbeitsmappe_Pfad & "\upload_" & Date &
".csv", _
FileFormat:=xlCSV, Local:=True
ActiveWorkbook.Close (True)
Sheets("c").Select
Application.ScreenUpdating = True
End Sub

Kann mir jemand helfen meinen Code so zu àndern, dass ich ein sauberes CSV
(Semikolon getrennt) erhalte.

Danke und Gruß Sascha
 

Lesen sie die antworten

#1 Thomas Ramel
22/08/2007 - 21:40 | Warnen spam
Grüezi Sascha

Sascha W. schrieb am 22.08.2007

ich weiß bereits durch andere threads, dass ich Local:=True verwenden soll,
um ein Semikolon getrenntes CSV zu erhalten. Habe nur das Problem, dass ich
Kollegen habe, die keine deutsche Version benutzen und deshalb Local:=True
mich nicht weiterbringt.



Das heisst deine Kollegen sollen ebenfalls semikolon-getrennte .CSV-Dateien
erstellen?

[]

Kann mir jemand helfen meinen Code so zu àndern, dass ich ein sauberes CSV
(Semikolon getrennt) erhalte.



Ich schlage dir die Verwendung der folgenden Routine vor. Hier kannst Du
den Bereich angeben, den Du auslesen willst sowie Dateiname, Pfad und sonst
noch einiges vorgeben:

Sub SaveCSV_a()
Dim a As Variant
Dim b() As String
Dim D() As String
Dim Z As Long
Dim S As Byte
Dim R As Long
Dim C As Byte

'Speicherpfad eintragen
Const Path As String = "C:\Test\"
'Dateiname eintragen
Const Filename As String = "Test2"
'Dateiendung anpassen (.txt, .csv oder andere)
Const Extension As String = ".TXT"
'Trennzeichen anpassen (Semikolon, Komma oder andere)
Const Separator As String = ";"
'Texerkennungszeichen anpassen (kann meist so bleiben)
Const Wrapper As String = """"

'Zu speichernden Bereich eintragen z.B:
'Worksheet("DeinTabellenblatt").UsedRange
'Worksheet("DeinTabellenblatt").Range("A1:B10")

a = ActiveSheet.UsedRange

If Not IsEmpty(a) Then
Z = UBound(a, 1)
S = UBound(a, 2)
ReDim b(S - 1)
ReDim D(Z - 1)
For R = 1 To Z
For C = 1 To S
If InStr(1, a(R, C), Separator) > 0 Then
'Rows whith cells including the Separator
'put in Wrapper
b(C - 1) = Wrapper & a(R, C) & Wrapper
Else
b(C - 1) = a(R, C)
End If
Next C
D(R - 1) = Join(b(), Separator)
Next R
Open Path & Filename & Extension For Output As #1
Print #1, Join(D(), vbCrLf)
Close #1
End If
End Sub



Mit freundlichen Grüssen
Thomas Ramel

- MVP für Microsoft-Excel -
[Win XP Pro SP-2 / xl2003 SP-2]
Microsoft Excel - Die ExpertenTipps

Ähnliche fragen