AW: An CSV und VBA-Spezialisten
25.06.2005 23:30:31
Roli
Tut mir furchtbar leid. Mein Fehler. Ich habe gestern die Datei mit Kennwort getestet und ich habe vergeßen sie zu entfernen. Anbei nochmal die Dateien
https://www.herber.de/bbs/user/24189.zip
Der CSV Code befindet sich in der Datei auftragsformular_ultraneu_preise.xls
Im VBA unter Modul moAddin:
Sub Speichern_csv()
Dim sFile As Variant, msgAntwort As Variant
Dim Daten As Range, Zeile As Object, Zelle As Object
Dim strTemp As String
On Error GoTo errorhandler
With ActiveSheet
sFile = Application.GetSaveAsFilename(InitialFilename:=Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & ".csv", _
FileFilter:="CSV-Datei (*.csv), *.csv")
'sFile = Application.GetSaveAsFilename(InitialFilename:="DeineVorgabe" & ".csv", _
FileFilter:="CSV-Datei (*.csv), *.csv")
If sFile = False Then Exit Sub
If Dir(sFile) <> "" Then
msgAntwort = MsgBox("Die Datei '" & sFile & "' besteht bereits. Möchten Sie die bestehende Datei ersetzen?", _
vbQuestion + vbYesNo, "Warnung")
If msgAntwort = vbNo Then Exit Sub
End If
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
strTemp = strTemp & ";" & Zelle
End If
Next Zelle
Print #1, strTemp
strTemp = ""
Next Zeile
Close #1
End With
MsgBox "Die Datei wurde erfolgreich exportiert.", vbInformation, "Export erfolgreich"
ActiveWorkbook.FollowHyperlink <a href="Address:="http://www.moliv.at",">Address:="http://www.moliv.at",</a> NewWindow:=True
Exit Sub
errorhandler:
MsgBox "Es ist ein Fehler aufgetreten. Die Datei konnte nicht vollständig exportiert werden.", vbCritical, "Fehlermeldung"
End Sub
Komischerweise geht dieser Code mit einer neuen Arbeitsmappge jedoch nicht mit diesem Formular.
Liebe Grüße
Roli