Export in neue CSV-Datei

Sub Export_csv_datei()
Dim iRow As Integer, i As Integer
Dim sTxt As String, sFile As String, zeile As String
Application.ScreenUpdating = False
sFile = Application.DefaultFilePath & "Test.csv"
Open sFile For Output As #1
Print #1, "
" 'Beginn Tabelle
For iRow = 100 To 3000
For i = 1 To 4
zeile = zeile
Next i
Next iRow
Close
Workbooks.open  & sFile, vbNormalFocus
Application.ScreenUpdating = True
End Sub



	
	

		

			

				

					
					 AW: Export in neue CSV-Datei
				
				

					Tino
				
			
		
		

			
								

Hallo,

zufällig habe ich ein Beispiel dafür.

Es ist jetzt keine Prüfung eingabaut die überprüft, ob die Zellen alles gefüllt sind.

Option Explicit


Sub SaveAs_Textfile()
Dim strText1 As String
Dim strTemp As String
Dim F As Integer, A As Long
Dim strSpeicherPfad As String

'Speicherort vorgeben******* 
ChDrive "C:\"
ChDir "C:\Neuer Ordner"

'Dialog speichern unter 
strSpeicherPfad = Application.GetSaveAsFilename("MeineTextDatei.csv", "Textdateien (*.csv), *.csv", , "TextFile speichern unter:")

'Abbrechen gedrückt 
If strSpeicherPfad = "Falsch" Then
 MsgBox "Verarbeitung vom Benutzer abgebrochen!", vbInformation
 Exit Sub
End If

'Sicherheitsabfrage, Datei schon vorhanden 
If Dir$(strSpeicherPfad, vbDirectory) <> "" Then
 If MsgBox("Datei existiert schon! Wollen Sie diese Daten wirklich überschreiben?", vbYesNo) = vbNo Then
  MsgBox "Verarbeitung vom Benutzer abgebrochen!", vbInformation
  Exit Sub
 End If
End If

'Text zusammensetzen 
For A = 100 To 3000 'Zeile 100 bis 3000 
    With Application
        strText1 = Join(.Transpose(.Transpose(Range("A" & A & ":C" & A))), ";") 'Spalte A-C 
        strTemp = strTemp & strText1 & vbCrLf
    End With
Next A

'Zeilenumbruch am ende entfernen 
strTemp = Left$(strTemp, Len(strTemp) - 1)

'Textdatei speichern 
  F = FreeFile
  Open strSpeicherPfad For Output As #F
  Print #F, strTemp
  Close #F

'Information 
MsgBox "Die Textdatei:" & Chr(13) & strSpeicherPfad & Chr(13) & "wurde erfolgreich gespeichert!"


End Sub


Gruß Tino


		
	
	

	
	

		

			

				

					
					 AW: Export in neue CSV-Datei
				
				

					Franz
				
			
		
		

			
								

Hallo Tino,

vielen Dank. Wie kann ich die Spalte B in der neuen CSV-Datei

noch mit dem Format (hh:mm) hinterlegen. Auch sollte die Datei

gleich geöffnet werden.

Danke. Gruß Franz


		
	
	

	
	
	
	

	
	

		

			

				

					
					 AW: Export in neue CSV-Datei
				
				

					Tino
				
			
		
		

			
								

Hallo,

das geht so, 

beachte aber dass Du dass Trennzeichen verwendest, 

dass bei Dir auf dem System als Dezimal Delimiter verwendet wird.

Bei mir ist es das Semikolon, kann aber genau so gut dass Komma sein.

Sub SaveAs_Textfile()
Dim strText1 As String
Dim strTemp As String
Dim F As Integer, A As Long
Dim strSpeicherPfad As String

'Speicherort vorgeben******* 
ChDrive "C:\"
ChDir "C:\Neuer Ordner"

'Dialog speichern unter 
strSpeicherPfad = Application.GetSaveAsFilename("MeineTextDatei.csv", "Textdateien (*.csv), *.csv", , "TextFile speichern unter:")

'Abbrechen gedrückt 
If strSpeicherPfad = "Falsch" Then
 MsgBox "Verarbeitung vom Benutzer abgebrochen!", vbInformation
 Exit Sub
End If

'Sicherheitsabfrage, Datei schon vorhanden 
If Dir$(strSpeicherPfad, vbDirectory) <> "" Then
 If MsgBox("Datei existiert schon! Wollen Sie diese Daten wirklich überschreiben?", vbYesNo) = vbNo Then
  MsgBox "Verarbeitung vom Benutzer abgebrochen!", vbInformation
  Exit Sub
 End If
End If

'Text zusammensetzen 
For A = 100 To 3000 'Zeile 100 bis 3000 
        strText1 = Cells(A, 1) & ";" & Format(Cells(A, 2), "hh:mm") & ";" & Cells(A, 3)
        strTemp = strTemp & strText1 & vbCrLf
Next A

'Zeilenumbruch am ende entfernen 
strTemp = Left$(strTemp, Len(strTemp) - 1)

'Textdatei speichern 
  F = FreeFile
  Open strSpeicherPfad For Output As #F
  Print #F, strTemp
  Close #F

'Information 
If MsgBox("Die Textdatei:" & Chr(13) & strSpeicherPfad & Chr(13) & _
    "wurde erfolgreich gespeichert!" & Chr(13) & Chr(13) & _
    "Wollen Sie diese Datei jetzt öffnen?", vbYesNo) = vbYes Then

Workbooks.Open Filename:=strSpeicherPfad

End If

End Sub


Gruß Tino


		
	
	

	
	

		

			

				

					
					 AW: Export in neue CSV-Datei
				
				

					Ramses
				
			
		
		

			
								

Hallo

Mal eine ganz einfache Variante die das macht was du willst, incl. dem Uhrzeit Format



Sub CSV_Export()
Range("A100:C3000").Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=Application.DefaultFilePath & "Test.csv", FileFormat:=xlCSV,  _
local:=True
End Sub


Gruss Rainer


		
	
	

	
	

		

			

				

					
					 AW: Export in neue CSV-Datei
				
				

					Franz
				
			
		
		

			
								

Funktioniert:

Danke Rainer und Timo!

Gruß Franz


		
	
	

	
	

		

			

				

					
					 @Ramses
				
				

					Tino
				
			
		
		

			
								

Hallo Ramses,

Angeber, einfach kann jeder. ;-)

Gruß Tino


		
	
	

	
	

		

			

				

					
					 @Tino
				
				

					Ramses
				
			
		
		

			
								

Hallo Tino

Wie schon des öfteren angesprochen :-)

Back to the roots...., auf die Bäume klettern kann man immer noch.

Gruss Rainer