Office: Makro kürzt Dateinamen bei Import

Hi zusammen,

da ich kein VBA Profi (sondern wenn überhaupt Anfänger bin) habe ich mir ein Makrocode zusammengeklaut um 20 .csv Dateien automatisiert in eine Excel zu importieren. Sinn ist, dass die CSV aus einer Datenbank kommen und immer mal wieder aktualisiert werden und ich die mit excel dann auswerte. Code sieht folgendermaßen aus:

Code:

Sub ImportiereCSVDateien()
    Const CSVPFAD = "E:\csv-dateien"
    Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet
    Set fso = CreateObject("Scripting.Filesystemobject")
    Set wbTarget = ActiveWorkbook
    Application.DisplayAlerts = False
    'Lösche alle Worksheets bevor wir alle neu anlegen
    If wbTarget.Worksheets.Count > 5 Then
        For i = 6 To i = 50
        'Damit der erst beim sechsten Sheet anfängt
            wbTarget.Worksheets(i).Delete
            'Jetzt wurden die alten Sheets löschen
        Next
    End If
    For Each f In fso.GetFolder("N:\01_GF-Intern\01_Strategie\ITE-Strategie\HRM2\Gesamtdaten\11.03.2015").Files
    'Alle Dateien aus dem Ordner sichten
        If LCase(Right(f.Name, 3)) = "csv" Then
        'Alle Dateien mit der Endung "csv" werden beachtet
            Workbooks.OpenText Filename:=f.Path
            Set wbSource = ActiveWorkbook
            On Error Resume Next
            Set ws = wbTarget.Worksheets(f.Name)
            If Err <> 0 Then
                Set ws = wbTarget.Worksheets.Add
                ws.Name = f.Name
                ws.Range("A:ZZ").Clear
            End If
        
            wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True
            wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")
            wbSource.Close False
        End If
    Next
    Application.DisplayAlerts = True
    Set fso = Nothing
End Sub

Das Problem ist nun, dass zwei der CSV Dateien einen sehr langen Dateinamen haben. Diese Sheetnamen dieser CSVs werden immer abgeschnitten beim Import. Das Problem wenn ich über das Makro dann alle Dateien auswechsle ist, dass er die beiden Dateien dann mit den Namen Tabelle1 und Tabelle2 beim nächsten Import mit Tabelle3 und Tabelle4 betitelt. Dadurch sind die Bezüge dann logischerweise verschoben.

Gibt es eine Möglichkeit dem Makro zu sagen, dass er den KOMPLETTEN Dateinamen als Sheetnamen verwenden soll?

Ich hoffe ich habe mich halbwegs klar ausgedrückt. Ansonsten freue ich mich über Rückfragen oder Lösungsansätze :-)

Viele Grüße und ein schönes Wochenende

 

Hallo,

wenn die Dateinamen länger als 31 Zeichen sind, geht das nicht, denn Tabellennamen können nicht mehr als 31 Zeichen enthalten. Wenn die Dateinamen der CSV's so aufgebaut sind, dass z.B. immer die ersten 16 Zeichen einen eindeutigen Namen ergeben, könntest Du immer die ersten 16 Zeichen verwenden: ws.Name = Left(f.Name, 16) Ansonsten wäre zu klären, wieviele CSV's es sind und ob nicht vielleicht Platzhaltertabellen verwendet werden können oder eine Mapping-Tabelle. Dafür kenne ich abder den Aufbau Deiner Mappe nicht.

Gruß

 

Hallo,

vielen Dank, genau das habe ich gesucht. Ab dem 30. Zeichen gab es Eindeutigkeiten :-)

Liebe Grüße