|
Hallo,
folgendes Makro soll automatisch abgespeichert werden.
Makro funktioniert einwandfrei - nur das manuelle Abspeichern möchte ich mir auch noch ersparen.
"ActiveWorkbook.SaveAs" habe ich bisher erfolglos integriert. Die erhaltene csv.-Datei hat leider nicht mehr
das gewünschte Format. Was muss ich tun? Vielen Dank für Eure Hilfe vorab.
Sub CSVFile()
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim FeldSep As String
Dim str As String
Const LW = "c:\"
Const Pfad = "c:\X\Y\Desktop\"
Dim FName As Variant
Dim Datumzeitstempel As String
Dim Jetzt As Date
Jetzt = Now()
Datumzeitstempel = Year(Date) & Format(Month(Date), "00") & Format(Day(Date), "00")
Datumzeitstempel = Datumzeitstempel & "" & Format(Hour(Jetzt), "00") & Format(Minute(Jetzt), "00") & Format(Second(Jetzt), "00")
ChDrive LW
ChDir Pfad
FName = Application.GetSaveAsFilename("date_" & Datumzeitstempel & ".csv")
ListSep = ","
If Selection.Cells.Count > 1 Then
Set SrcRg = Selection
Else
Set SrcRg = ActiveSheet.UsedRange
End If
Open FName For Output As #1
For Each CurrRow In SrcRg.Rows
CurrTextStr = ""
FeldSep = IIf(CurrRow.Row < 2, "", """")
For Each CurrCell In CurrRow.Cells
CurrTextStr = CurrTextStr & FeldSep & CurrCell.Value & FeldSep & ListSep
Next
While Right(CurrTextStr, 1) = ListSep
CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
Print #1, CurrTextStr
Next
Close #1
End Sub
|