Zeile aus CSVs in Excel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub LeseFiles() Dim Fso, Ordner, varDatei Dim i As Long, meCalc As Integer Dim objDatei As Workbook Dim EinfügBereich As Range Set Fso = CreateObject("Scripting.FileSystemObject") Set EinfügBereich = Range("A1:C1") 'erster Einfügebereich!!! Set Ordner = Fso.getfolder("C:\Mein_Ordner") 'Pfad Ordner angeben!!! With Application meCalc = .Calculation .EnableEvents = False .ScreenUpdating = False .Calculation = xlCalculationManual For Each varDatei In Ordner.Files If LCase(varDatei) Like "*.csv" Then Set objDatei = Workbooks.Open(varDatei, False, True) 'kopiere Zellen objDatei.Sheets(1).Range("A55:C55").Copy _ EinfügBereich.Offset(i, 0) objDatei.Close False i = i + 1 End If Next varDatei .Calculation = meCalc .EnableEvents = True .ScreenUpdating = True End With End Sub

Option Explicit Dim boFehler As Boolean Sub LeseFiles() Dim Fso, Ordner, varDatei, varDaten Dim i As Long, meCalc As Integer Dim objDatei As Workbook Dim EinfügBereich As Range Set Fso = CreateObject("Scripting.FileSystemObject") Set EinfügBereich = Range("A1:C1") 'erster Einfügebereich!!! Set Ordner = Fso.getfolder("C:\Forum\CSV") 'Pfad Ordner angeben!!! With Application meCalc = .Calculation .EnableEvents = False .ScreenUpdating = False .Calculation = xlCalculationManual For Each varDatei In Ordner.Files If LCase(varDatei) Like "*.csv" Then varDaten = txt_Read(varDatei) If boFehler = False Then Do While i < 3 Or i <= Ubound(varDaten) EinfügBereich(i + 1) = varDaten(i) i = i + 1 Loop i = 0 Set EinfügBereich = EinfügBereich.Offset(1, 0) End If End If Next varDatei .Calculation = meCalc .EnableEvents = True .ScreenUpdating = True End With End Sub Public Function txt_Read(ByVal sFilename As String) Dim F As Integer Dim sInhalt As String Dim varText boFehler = False F = FreeFile Open sFilename For Binary As #F sInhalt = Space$(LOF(F)) Get #F, , sInhalt Close #F varText = Split(sInhalt, vbNewLine) On Error GoTo Fehler txt_Read = Split(varText(54), ";") Exit Function Fehler: boFehler = True End Function

Public Function txt_Read(ByVal sFilename As String) Dim F As style='color:#0000EE'>Integer Dim sInhalt As String Dim varText boFehler = False F = FreeFile Open sFilename For Binary As #F sInhalt = Space$(LOF(F)) Get #F, , sInhalt Close #F varText = Split(sInhalt, vbNewLine) On Error GoTo Fehler varText = Replace(varText, ".", ",") txt_Read = Split(varText(54), ";") Exit Function Fehler: boFehler = True End Function

Hallo,
die Trennung erfolgt bei dir mit Zeichen Tabulator.
Haben schon ein seltsames Format, von woher kommen den diese .csv Dateien,
werden diese von einer Anlage Generiert?
So funktioniert es mit deiner Beispieldatei.

Option Explicit
Dim boFehler As Boolean
Sub LeseFiles()
Dim Fso, Ordner, varDatei, varDaten
Dim i As Long, meCalc As Integer
Dim objDatei As Workbook
Dim EinfügBereich As Range
Set Fso = CreateObject("Scripting.FileSystemObject")

Set EinfügBereich = Range("A1:C1") 'erster Einfügebereich!!! 
Set Ordner = Fso.getfolder("C:\Forum\CSV") 'Pfad Ordner angeben!!! 

With Application
 meCalc = .Calculation
 .EnableEvents = False
 .ScreenUpdating = False
 .Calculation = xlCalculationManual
    
    For Each varDatei In Ordner.Files
     If LCase(varDatei) Like "*.csv" Then
        varDaten = txt_Read(varDatei)
     If boFehler = False Then
        EinfügBereich.NumberFormat = "General"
       Do While i < 3 Or i <= Ubound(varDaten)
          If IsNumeric(varDaten(i)) Then varDaten(i) = Replace(varDaten(i), ",", ".")
          EinfügBereich(i + 1) = varDaten(i)
          i = i + 1
       Loop
            i = 0
       Set EinfügBereich = EinfügBereich.Offset(1, 0)
     
     End If
     End If
    Next varDatei
 
 .Calculation = meCalc
 .EnableEvents = True
 .ScreenUpdating = True
End With
End Sub


Public Function txt_Read(ByVal sFilename As String)
Dim F As Integer
Dim sInhalt As String
Dim varText
boFehler = False

    F = FreeFile
    Open sFilename For Binary As #F
    sInhalt = Space$(LOF(F))
    Get #F, , sInhalt
    Close #F
 varText = Split(sInhalt, vbNewLine)

On Error GoTo Fehler
    varText(54) = Replace(varText(54), " ", "")
    txt_Read = Split(varText(54), vbTab)

Exit Function
Fehler:
 boFehler = True
End Function

Gruß Tino

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeile aus CSVs in Excel

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread