csv als xls

Sub Open_CSV() Dim lstrCSV_Datei As String lstrCSV_Datei = Dir("C:\_copy\SamGan\*.CSV") Do Until lstrCSV_Datei = "" Workbooks.OpenText Filename:= _ "c:\_copy\SamGan\" & lstrCSV_Datei, local:=True Range("A:A").TextToColumns , DataType:=xlDelimited, Semicolon:=True lstrCSV_Datei = Dir Loop End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: csv als xls

01.09.2008 15:09:00

Jogy

AW: csv als xls

01.09.2008 15:39:51

Ralf

AW: csv als xls

01.09.2008 15:48:20

Rudi

AW: csv als xls

01.09.2008 16:04:00

Ralf

AW: csv als xls

01.09.2008 16:11:00

fcs

AW: csv als xls

01.09.2008 16:19:30

Ralf

AW: csv als xls

01.09.2008 16:42:00

Ralf

AW: csv als xls

01.09.2008 16:14:51

Rudi

Sub Open_CSV() Dim lstrCSV_Datei As String Dim wbK as Workbook lstrCSV_Datei = Dir("C:\_copy\SamGan\*.CSV") Do Until lstrCSV_Datei = "" Set wbK = Workbooks.OpenText Filename:= _ "c:\_copy\SamGan\" & lstrCSV_Datei, local:=True Range("A:A").TextToColumns , DataType:=xlDelimited, Semicolon:=True wbK.SaveAs fileFormat:=xlNormal lstrCSV_Datei = Dir Loop End Sub

Sub Open_CSV() Dim lstrCSV_Datei As String Dim wbK As Workbook lstrCSV_Datei = Dir("C:\_copy\SamGan\*.CSV") Do Until lstrCSV_Datei = "" Set wbK = Workbooks.OpenText(Filename:= _ "c:\_copy\SamGan\" & lstrCSV_Datei, local:=True) Range("A:A").TextToColumns , DataType:=xlDelimited, Semicolon:=True wbK.SaveAs FileFormat:=xlNormal lstrCSV_Datei = Dir Loop End Sub

Sub Open_CSV() Dim lstrCSV_Datei As String Dim strPfad As String Dim wbK As Workbook strPfad = "C:\_copy\SamGan\" lstrCSV_Datei = Dir(strPfad & "*.CSV") Do Until lstrCSV_Datei = "" Workbooks.OpenText Filename:=strPfad & lstrCSV_Datei, local:=True Set wbK = ActiveWorkbook Range("A:A").TextToColumns , DataType:=xlDelimited, Semicolon:=True wbK.SaveAs FileFormat:=xlWorkbookNormal, addtomru:=True ' wbK.Close lstrCSV_Datei = Dir Loop End Sub

Hallo,
als Alternative:


Public intCalculation As Integer
Sub CSV2XLS()
'Alle .csv (Trennzeichen ;) eines Ordners in .xls umwandeln
Dim oFS As Object, oFolder As Object, oFile As Object
Dim strFolder As String
Dim strTxt As String, myArr, lngL As Long, WKS As Worksheet, iFREE As Integer
With Application.FileDialog(4)
.InitialFileName = "n:\"
.InitialView = 2
.Title = "Bitte einen Ordner wählen"
If .Show = -1 Then
strFolder = .SelectedItems(1)
Else
Exit Sub
End If
End With
On Error GoTo FEHLER
DoEvents
GetMoreSpeed
Set oFS = CreateObject("scripting.filesystemobject")
Set oFolder = oFS.getfolder(strFolder)
iFREE = FreeFile
For Each oFile In oFolder.Files
If oFile.Name Like "*.csv" Then
lngL = 1
Open oFile For Input As iFREE
Set WKS = Workbooks.Add(1).Sheets(1)
Do Until EOF(iFREE)
Line Input #iFREE, strTxt
myArr = Split(strTxt, ";")
With WKS
.Range(.Cells(lngL, 1), .Cells(lngL, UBound(myArr) + 1)) = myArr
End With
lngL = lngL + 1
Loop
Close #iFREE
With WKS.Parent
.SaveAs Replace(oFile, ".csv", ".xls"), xlWorkbookNormal
.Close False
End With
End If
Next oFile
AUFRAEUMEN:
Set oFile = Nothing
Set oFolder = Nothing
Set oFS = Nothing
GetMoreSpeed False
Exit Sub
FEHLER:
If Err.Number Then
MsgBox "Fehler!" & vbLf & Err.Description
Err.Clear
Resume AUFRAEUMEN
End If
End Sub
Sub GetMoreSpeed(Optional ByVal Modus As Boolean = True)
If Modus = True Then intCalculation = Application.Calculation
With Application
.ScreenUpdating = Not Modus
.EnableEvents = Not Modus
.Calculation = IIf(Modus = True, xlManual, intCalculation)
.Cursor = IIf(Modus = True, 2, -4143)
End With
End Sub

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread