Export in CSV-Datei
28.06.2008 10:36:49
bully
mit eurer Hilfe habe ich vor einiger Zeit ein Makro zum Exportieren von Daten in eine TXT Datei erstellen können. Nun macht die EDV bekanntlich einen schnellen Wandel durch. Dies betrifft nun auch mich mit meinem Export-Modul. Es wurde eine neue Software für die Datenbearbeitung eingeführt, diese verarbeitet nun nicht mehr TXT-Dateien mit Tabstopp Trennung, sondern CSV-Dateien mit Strichpunkt Trennung. Mit Hilfe von Archiv und Recherche habe ich einige Anhaltspunkt gefunden, ich kann sie aber nicht richtig in meinem Modul integrieren. Das heisst, ich bringe es nicht zum laufen. Kann mir jemand von euch helfen? Den Code habe ich euch unten eingefügt.
Besten Dank.
Gruss bully
Option Explicit
Sub export7()
Dim strSep As String, strDat As String, _
iCol As Byte, iRow As Integer, _
iR As Integer, iC As Byte, strTxt As String, _
strMldg As String
iRow = ActiveSheet.UsedRange.Rows.Count
iCol = ActiveSheet.UsedRange.Columns.Count
strSep = 9
If strSep = "" Then Exit Sub
If strSep = "9" Then
strSep = Chr(9)
Else
strSep = Left(Trim(strSep), 1)
End If
DateiName:
strDat = InputBox("Dateiname?", "DateiName", ThisWorkbook.Path & "\SPRUNGM____1148___" & _
Format(Now, "YYYYMMDDHHMMSS") & ".csv")
If strDat = "" Then Exit Sub
If InStr(strDat, ":\") = 0 Then
strDat = ThisWorkbook.Path & "\" & strDat
End If
If Dir(strDat) "" Then
strMldg = MsgBox("Datei bereits vorhanden. Überschreiben?", vbYesNo)
If strMldg = vbNo Then GoTo DateiName
End If
On Error GoTo DateiFehler
Open strDat For Output As #1
For iR = 3 To iRow 'überspringt die drei ersten Zeilen
strTxt = ""
For iC = 1 To iCol
If (iC >= 1 Or iR "" Then Print #1, strTxt
Next iR
Close #1
MsgBox ("Die Datei " & strDat & " wurde angelegt.")
Exit Sub
DateiFehler:
MsgBox ("Fehler in Dateinamen!")
Resume DateiName
End Sub