Datei automatisch in csv abspeichern
25.09.2005 13:49:09
Roli
MIt folgendem Code speichere ich die aktuelle Datei in eine Excel-Datei ab.
Sub Speichern_unter()
On Error Resume Next
Dim mldg As String, titel As String, stil As Integer
Dim sFile As Variant, msgAntwort As Variant
Dim Daten As Range, Zeile As Object, Zelle As Object
Dim strTemp As String
Dim Pfad$, name$
'On Error GoTo errorhandler
Pfad = "C:\excel\"
name = Sheets(Eingabe).Range("a1").Value
MsgBox "Sie können einen beliebigen Dateinamen eingeben. Standardgemäß werden die Auftragsformulare in " & Pfad & " abgespeichert!"
With ActiveSheet
sFile = Application.GetSaveAsFilename(InitialFilename:=Left(Pfad & name, Len(Pfad & name)) & ".xls", _
FileFilter:="Microsoft Excel-Arbeitsmappe (*.xls), *.xls")
If sFile <> False Then ActiveWorkbook.SaveAs Filename:=sFile
End With
mldg = "Wollen Sie auch das gespeicherte Auftragsformular auf das CSV-Format umkonvertieren?"
stil = vbYesNo + vbInformation + vbDefaultButton2
titel = "CSV?"
'---Nachfrage, ob umkonvertiert werden soll?----
If MsgBox(mldg, stil, titel) = vbYes Then
Speichern_csv
End If
End Sub
Es läuft soweit ganz gut, nur möchte ich, dass automatisch, nachdem in xls-datei gespeichert wurde, auch eine csv-kopie angelegt wird. Bisher wurde mit diesem Code umkonvertiert und sollte auch so bleiben. Diesen Code habe ich aus diesem Forum irgendwo gefunden.
Dim Daten As Range, Zeile As Object, Zelle As Object
Dim strTemp As String
Set Daten = .UsedRange
Close
Open sFile For Output As #1
For Each Zeile In Daten.Rows
For Each Zelle In Zeile.Cells
If Zelle.Column = 1 Then
strTemp = Zelle
Else
If Zelle.Column = 3 And IsNumeric(Zelle) Then
strTemp = strTemp & ";" & Format(Zelle, "00")
Else
strTemp = strTemp & ";" & Zelle
End If
End If
Next Zelle
Print #1, strTemp
strTemp = ""
Next Zeile
Close #1
Weiß jemand, wie nach dem Speichern im Hintergrund eine csv-kopie in einem vorbestimmten Ordner anlegt? Die Dateiname wird aus der Zelle A1 herangezogen.
Für jede weitere Hilfe bin ich dankbar.
Roli