CSV-Teiler soll speichern können
09.04.2008 12:42:46
Chris
habe hier einen Code der mir eine CSV-Datei nach einer festgelegten Zeilenanzahl teilt.
Es werden also Datenblätter hinzugefügt bis keine Zeilen aus der Ursprungsdatei mehr übrig sind.
So, nun möchte ich gerne alle angelegten Tabellenblätter jeweils einzeln in eine CSV Datei schreiben
(z. B. 1.csv, 2.csv, 3.csv usw. bis keine Tabellenblätter mehr übrig sind). Da ich aber fast keine Kenntnisse
mit VBA habe wüsste ich jetzt auch nicht wo ich ansetzen soll. Ich hätte mir sowas gedacht:
Dim i as integer
For i = i + 1
sheets(i).activate
sheets(i).saveas (i.csv)
next i
Nur weiß ich jetzt leider nicht wo ich das genau hinschreiben muss.
Bin für jeder Hilfe dankbar. In einem anderen Forum meinte jemand das das gar nicht geht.
Hier der Code wie er bis jetzt auch funktioniert.
Gruß
Public Function FileTeilen()
On Error GoTo Hell
Dim fso As New FileSystemObject, SR As TextStream
Dim datenfeld, Datenzeile, Datenstring As String
Dim rcount As Double, mcount As Integer, x As Integer
Dim datensheet As Variant
Dim y As String
y = InputBox("Bitte geben Sie die Anzahl an, bei der gesplittet werden soll!", "Filetransfer")
Set SR = fso.OpenTextFile(Application.GetOpenFilename)
mcount = 1
rcount = 0
ReDim datenfeld(y, 200)
Do
Datenstring = SR.ReadLine
Datenzeile = Split(Datenstring, ";")
For x = 0 To UBound(Datenzeile)
datenfeld(rcount, x) = Datenzeile(x)
Next
rcount = rcount + 1
If rcount > y Then
Set datensheet = Sheets.Add
datensheet.Range("A1").Resize(UBound(datenfeld, 1), UBound(datenfeld, 2)) = datenfeld
mcount = mcount + 1
rcount = 0
Erase datenfeld
ReDim datenfeld(y, 200)
End If
Loop While Not SR.AtEndOfStream
Set datensheet = Sheets.Add
datensheet.Range("A1").Resize(UBound(datenfeld, 1), UBound(datenfeld, 2)) = datenfeld
Hell:
MsgBox Err.Description, vbCritical, "Ein Fehler ist aufgetreten!"
Exit Function
End Function