Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
372to376
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
372to376
372to376
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

erzwingen von (;) beim EXP >VBA<

erzwingen von (;) beim EXP >VBA<
03.02.2004 09:41:03
Sandra
Hallo Vba's
ich habe ein Macro, mit dem ich eine CSV rausschreiben möchte.
Leider ist die Trennung der CSV ein (,) ich brauche jedoch ein (;)
Wer kann mir weiterhelfen, so dass das (;) erzwungen wird.
Gruss Sandra


Sub ExportCSV()
Sheets("CSV").Select
Sheets("CSV").Copy
Dim TB As Worksheet
Dim dName$
Set TB = ActiveWorkbook.Worksheets(1)
'Speicherpfad der name der DATEI setzt sich aus den Zellen r3 r4 zusammen.
dName = "E:\CATTemp\" & _
TB.Range("k2") & "_" & _
TB.Range("l2") & ".csv"
ActiveWorkbook.SaveAs dName, FileFormat _
:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
Sheets("Startseite").Select
Range("a1").Value = 1
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: erzwingen von (;) beim EXP >VBA<
03.02.2004 09:53:35
Christoph Dümmen
Hallo Sandra,
ich hatte dafür keine Lösung gefunden und hatte dann die Datei halt direkt geschrieben.
Du brauchst natürlich nicht das Ganze drumherum aus meinem Szenario.
Gruß
Christoph

Sub CreateImportFiles()
On Error GoTo err_CreateImportFiles
Dim sh As Worksheet
Dim shNew As Worksheet
Dim rData As Range
Dim wNew As Workbook
Dim strPath As String
Dim strFileName As String
Dim strTMP As String
Dim zeile%, spalte%
Dim i%
strPath = Worksheets("Overview").Range("B4")
Application.ScreenUpdating = False
For Each sh In Worksheets
If sh.Name <> "Overview" Then
strFileName = strPath & "\" & sh.Name & ".txt"
i = i + 1
Application.StatusBar = "Creating file " & i & " of " & Worksheets.Count - 1
Set rData = sh.Range(GetAddress(sh.Name))
rData.Copy
Set wNew = Workbooks.Add
Set shNew = wNew.Worksheets(1)
shNew.Name = sh.Name
shNew.Range("A1").PasteSpecial xlPasteAll
Open strFileName For Output As #1
For zeile = 1 To shNew.UsedRange.Rows.Count
For spalte = 1 To shNew.UsedRange.Columns.Count
strTMP = strTMP & CStr(shNew.Cells(zeile, spalte).Text) & ";"
Next spalte
strTMP = Left(strTMP, Len(strTMP) - 1)
Print #1, strTMP
strTMP = ""
Next zeile
Close 1
wNew.Close False
End If
Next
ExitHere:
On Error Resume Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.StatusBar = ""
Exit Sub
err_CreateImportFiles:
Select Case Err.Number
Case Else
MsgBox "Error in Procedure: CreateImportFiles" & vbCrLf & _
"Error ID: " & Err.Number & vbCrLf & _
"Description: " & Err.Description, _
vbExclamation, cAppTitle
End Select
Resume ExitHere
Exit Sub
Resume 'Testing only
End Sub

Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige