Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: VBA: CSV in xls konvertieren

VBA: CSV in xls konvertieren
30.07.2013 12:42:54
WalterK
Hallo,
den folgenden Code habe ich im Internet gefunden, damit sollen CSV-Dateien in XLS-Dateien konvertiert werden.
ABER:
1.) Fehler: Wenn ich die konvertierten xls-Dateien öffne ist alles in Spalte A angeführt, d.h. die Spaltentrennung hat nicht funktioniert.
2.) Frage: Wenn die Codezeile Workbooks.Open .FoundFiles(i), local:=False lautet wird als Trennzeichen ; angeführt, wenn ich auf True ändere wird als Trennzeichen , angeführt. Ist das richtig so?

Option Explicit
Sub Convert_CSV_to_XLS() 'funktioniert nur bei Office 2003
Dim i As Long, verz As String
Dim dateiForm As String
'Mit Backslash am Ende
verz = "D:\_Neuerungen vom HomePC - 2013.07.29\Test CSV in XLS\"
'Dateiform
dateiForm = "csv"
On Error GoTo fehler
ChDrive Left(verz, 2)
ChDir verz
With Application.FileSearch
.NewSearch
.LookIn = verz
.SearchSubFolders = False
.FileType = msoFileTypeAllFiles
.Execute
For i = 1 To .FoundFiles.Count
Application.StatusBar = "Datei " & i & " von " & .FoundFiles.Count & " wird  _
bearbeitet"
If Right(.FoundFiles(i), 3) = dateiForm Then
Application.ScreenUpdating = False
Debug.Print .FoundFiles(i)
Workbooks.Open .FoundFiles(i), local:=False
ActiveWorkbook.SaveAs Left(.FoundFiles(i), Len(.FoundFiles(i)) - 3) & "xls"
ActiveWorkbook.Close False
Application.ScreenUpdating = True
End If
Next i
End With
ErrorExit:
Application.ScreenUpdating = True
Application.StatusBar = False
Exit Sub
fehler:
MsgBox Err.Number & "; " & Err.Description
Resume ErrorExit
End Sub
Ich benutze Office 2003
Besten Dank für die Hilfe und Servus, Walter

Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA: CSV in xls konvertieren
30.07.2013 13:16:31
Rudi
Hallo,
Alternativcode:
Sub aaaaa()
Dim sFile As String, sPath As String, iFree As Integer
Dim arrCSV, arrTmp, arrXLS(), i As Long, j As Integer, n As Long
sPath = "c:\temp\"       'anpassen
sFile = Dir(sPath & "*.csv")
Application.ScreenUpdating = False
Do While Len(sFile)
iFree = FreeFile
Open sPath & sFile For Input As iFree
arrCSV = Split(Input(LOF(iFree), iFree), vbCrLf)
Close iFree
For i = 0 To UBound(arrCSV)
arrTmp = Split(arrCSV(i), ";")
n = Application.Max(n, UBound(arrTmp))
Next
ReDim arrXLS(1 To UBound(arrCSV) + 1, 1 To n + 1)
For i = 0 To UBound(arrCSV)
arrTmp = Split(arrCSV(i), ";")
For j = 0 To UBound(arrTmp)
arrXLS(i + 1, j + 1) = arrTmp(j)
Next
Next
With Workbooks.Add
.Sheets(1).Cells(1, 1).Resize(UBound(arrXLS), UBound(arrXLS, 2)) = arrXLS
.SaveAs sPath & Mid(sFile, 1, Len(sFile) - 4)
.Close
End With
sFile = Dir
Loop
End Sub

Gruß
Rudi

Anzeige
Danke Rudi, jetzt gehts. Servus, Walter
30.07.2013 13:31:01
WalterK
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige