Dateien splitten beim speichern ?

Frage an die Experten, ich habe alle Spalten in Spalte A zusammengefasst und möchte das jeweils 3000 Zeilen in einer Datei gespeichert werden so das ich am Ende Datei1.txt u. Datei2.txt usw. erhalte
und was noch wichtig ist beim speichern muss in jeder der Dateien am Anfang und am Ende eine Zeile eingefügt werden mit Text z.B. "Dateianfang" und "Dateiende"
hier ist der Code zum speichern den ich bisher verwendet habe da er auch die Anführungszeichen löscht, wie könnte ich ihn abändern ?
Gruß Andre


Sub speichern()
Dim Bereich          As Object
Dim ZZeile            As Object
Dim Zelle              As Object
Dim strTemp         As String
Const Dateiname      As String = "Datei"
Const Extension        As String = ".txt"
Const Trennzeichen  As String = ";"
Const Kapselzeichen As String = ""
Set Bereich = ActiveSheet.UsedRange
Open myPath & Dateiname & Extension For Output As #1
For Each ZZeile In Bereich.Rows
For Each Zelle In ZZeile.Cells
If InStr(1, Zelle.Text, Trennzeichen) > 0 Then
strTemp = strTemp & Kapselzeichen & CStr(Zelle.Text) & _
Kapselzeichen & Trennzeichen
Else
strTemp = strTemp & CStr(Zelle.Text) & Trennzeichen
End If
Next
strTemp = Left(strTemp, Len(strTemp) - 1)
Print #1, strTemp
strTemp = ""
Next
Close #1
'Cells.Select
'Selection.Delete Shift:=xlUp
'Range("A1").Select
'Application.Quit
'ThisWorkbook.Close SaveChanges:=False
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub speichern() Dim Bereich As Object Dim ZZeile As Object Dim Zelle As Object Dim strTemp As String Dim intNumber As Integer Const Dateiname As String = "Datei" Const Extension As String = ".txt" Const Trennzeichen As String = ";" Const Kapselzeichen As String = "" Set Bereich = ActiveSheet.UsedRange Open mypath & Dateiname & "1" & Extension For Output As #1 For Each ZZeile In Bereich.Rows intNumber = intNumber + 1 For Each Zelle In ZZeile.Cells If InStr(1, Zelle.Text, Trennzeichen) > 0 Then strTemp = strTemp & Kapselzeichen & CStr(Zelle.Text) & _ Kapselzeichen & Trennzeichen Else strTemp = strTemp & CStr(Zelle.Text) & Trennzeichen End If Next strTemp = Left(strTemp, Len(strTemp) - 1) Print #1, strTemp strTemp = "" If intNumber / 3000 = Int(intNumber / 3000) Then Close #1 Open mypath & Dateiname & intNumber / 3000 + 1 & Extension For Output As #1 End If Next Close #1 'Cells.Select 'Selection.Delete Shift:=xlUp 'Range("A1").Select 'Application.Quit 'ThisWorkbook.Close SaveChanges:=False End Sub

Sub speichern() Dim Bereich As Object Dim ZZeile As Object Dim Zelle As Object Dim strTemp As String Dim a As Byte Const Dateiname As String = "Datei" Const Extension As String = ".txt" Const Trennzeichen As String = ";" Const Kapselzeichen As String = "" Set Bereich = ActiveSheet.UsedRange For Each ZZeile In Bereich.Rows For Each Zelle In ZZeile.Cells If InStr(1, Zelle.Text, Trennzeichen) > 0 Then strTemp = strTemp & Kapselzeichen & CStr(Zelle.Text) & _ Kapselzeichen & Trennzeichen Else strTemp = strTemp & CStr(Zelle.Text) & Trennzeichen End If Next Next strTemp = "Dateianfang" & vbCrLf & Replace(strTemp, ";", vbCrLf) & "Dateiende" For a = 1 To 2 Open ActiveWorkbook.Path & "\" & Dateiname & a & Extension For Output As #1 Print #1, strTemp Close #1 Next a End Sub

Sub speichern() Dim Bereich As Object Dim ZZeile As Object Dim Zelle As Object Dim strTemp As String Dim a As Byte Const Dateiname As String = "Datei" Const Extension As String = ".txt" Application.ScreenUpdating = False Set Bereich = ActiveSheet.UsedRange For Each ZZeile In Bereich.Rows For Each Zelle In ZZeile.Cells strTemp = strTemp & CStr(Zelle.Text) & vbCrLf Next Next strTemp = Replace(strTemp, ";", "") strTemp = "Dateianfang" & vbCrLf & strTemp & "Dateiende" For a = 1 To 2 Open ActiveWorkbook.Path & "\" & Dateiname & a & Extension For Output As #1 Print #1, strTemp Close #1 Next a Application.ScreenUpdating = True End Sub

Sub speichern() Dim Bereich As Object Dim ZZeile As Object Dim Zelle As Object Dim strTemp As String Dim intNumber As Integer Const Dateiname As String = "Datei" Const Extension As String = ".txt" Const Trennzeichen As String = ";" Const Kapselzeichen As String = "" Set Bereich = ActiveSheet.UsedRange Open mypath & Dateiname & "1" & Extension For Output As #1 Print #1, "Dateianfang" For Each ZZeile In Bereich.Rows intNumber = intNumber + 1 For Each Zelle In ZZeile.Cells If InStr(1, Zelle.Text, Trennzeichen) > 0 Then strTemp = strTemp & Kapselzeichen & CStr(Zelle.Text) & _ Kapselzeichen & Trennzeichen Else strTemp = strTemp & CStr(Zelle.Text) & Trennzeichen End If Next strTemp = Left(strTemp, Len(strTemp) - 1) Print #1, strTemp strTemp = "" If intNumber / 3000 = Int(intNumber / 3000) Then Print #1, "Dateiende" Close #1 Open mypath & Dateiname & intNumber / 3000 + 1 & Extension For Output As #1 Print #1, "Dateiende" End If Next Print #1, "Dateiende" Close #1 'Cells.Select 'Selection.Delete Shift:=xlUp 'Range("A1").Select 'Application.Quit 'ThisWorkbook.Close SaveChanges:=False End Sub

Sub speichern() Dim Bereich As Object Dim ZZeile As Object Dim Zelle As Object Dim strTemp As String Dim a As Byte Dim z As Date z = Time Const Dateiname As String = "Datei" Const Extension As String = ".txt" ActiveSheet.UsedRange.Select Application.ScreenUpdating = False Set Bereich = ActiveSheet.UsedRange For Each ZZeile In Bereich.Rows For Each Zelle In ZZeile.Cells If Zelle > "" Then strTemp = strTemp & CStr(Zelle.Text) & vbCrLf Next Next strTemp = Replace(strTemp, ";", "") strTemp = "Dateianfang" & vbCrLf & strTemp & "Dateiende" For a = 1 To 2 Open ActiveWorkbook.Path & "\" & Dateiname & a & Extension For Output As #1 Print #1, strTemp Close #1 Next a MsgBox Format(Time - z, "hh:mm:ss") Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

Dateien splitten beim speichern ?

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread