Blatt als CSV speichern und zurück

Guten Morgen,
wäre schön, wenn mir jemand auf die Sprünge helfen könnte:
Ich möchte ein Tabellenblatt als csv- exportieren. Dazu speichere ich es per Button- Klick folgendem Code. Durch SaveAs wird die FileFormat- Eigenschaft auf xlCSV gesetzt. Ich möchte aber xlWorkbookNormal beibehalten, weil der Benutzer nach weiterer Arbeit die Mappe als xls speichern soll. Da FileFormat aber schreibgeschützt ist fällt mir nichts besseres ein, als noch einmal zu speichern, aber als xlWorkbookNormal.

Private Sub CommandButton1_Click()
Dim strAlterName As String
strAlterName = Me.Name 'Blattnamen merken
ChDrive ActiveWorkbook.Path 'Arbeitsverzeichnis auf Verzeichnis, in dem Excel- Datei liegt
ChDir ActiveWorkbook.Path
On Error GoTo fehler
ActiveWorkbook.SaveAs FileFormat:=xlCSV, CreateBackup:=False

Sheets(2).Name = strAlterName 'alten Namen wiederherstellen, weil dieser durch Speichern als CSV geändert

ActiveWorkbook.SaveAs FileFormat:=xlWorkbookNormal 'nur, um das Workbook wieder als xls zu kriegen
Exit Sub
fehler:
If Err Then MsgBox "Datei wurde nicht gespeichert"
Sheets(2).Name = strAlterName
End Sub

Funktionieren tut das schon, aber ich finds ein bischen umständlich.
Wie krieg ich mein Blatt als csv exportiert, ohne die zusätzliche Speicherung als xlWorkbookNormal?
Vielen Dank für Eure Hilfe.
Micha

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Micha,
hier ein Besipiel:


Sub Write_Csv()
F = FreeFile(0)
fname = InputBox("Enter the filename with Path:", _
"Please Enter Output File Name:")
MsgBox "File Selected is: " & fname
If fname <> False Then
Open fname For Output As #F
Set Rng = ActiveCell.CurrentRegion
Debug.Print Rng.Address
FCol = Rng.Columns(1).Column
LCol = Rng.Columns(Rng.Columns.Count).Column
Frow = Rng.Rows(1).Row
Lrow = Rng.Rows(Rng.Rows.Count).Row
For i = Frow To Lrow
outputLine = ""
For j = FCol To LCol
If j <> LCol Then
outputLine = outputLine & Cells(i, j) & ";"
Else
outputLine = outputLine & Cells(i, j)
End If
Next j
Print #F, outputLine
Next i
Close #F
End If
End Sub

oder einfacher:


Sub csvSpeichern()
exportfile = "C:\test.csv"
Dateinummer = FreeFile
Set TB = ThisWorkbook.Worksheets(1)
Open exportfile For Output As #Dateinummer
For z = 1 To TB.UsedRange.Rows.Count
If Cells(z, 2).Value = Text Then SL = 10 Else SL = 6
For s = 1 To SL
TMP = TMP & CStr(TB.Cells(z, s).Text) & ";"
Next s
TMP = Left(TMP, Len(TMP) - 1)
Print #Dateinummer, TMP
TMP = ""
Next z
Close #Dateinummer
End Sub

Gruß
Heinz

Private Sub CommandButton1_Click() Dim newname As String newname = "d:\daten\" & ActiveSheet.Name ActiveSheet.Copy ActiveWorkbook.SaveAs Filename:=newname, FileFormat:=xlCSV ActiveWorkbook.Close False End Sub

Sub OpenMe() Dim fname As Variant Dim myFilter As String myFilter = "Textdateien (*.txt),*.txt,Alle Dateien,*.*)" fname = Application.GetOpenFilename(myFilter, , "Hallöchen") If fname = False Then Exit Sub MsgBox fname, vbInformation, "Öffne mich" End Sub

Beliebteste Forumthreads (12 Monate)

Blatt als CSV speichern und zurück

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

207 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Blatt als CSV speichern und zurück

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

207 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread