Dateinamen einfügen mit VBA

Dieses Thema Dateinamen einfügen mit VBA im Forum "Microsoft Office Suite" wurde erstellt von flowmäster, 19. Aug. 2014.

Thema: Dateinamen einfügen mit VBA Hallo liebe Community, ich würde gerne mittels VBA vor jedem Eintrag den entsprechenden Quell-Dateinamen...

  1. Hallo liebe Community,

    ich würde gerne mittels VBA vor jedem Eintrag den entsprechenden Quell-Dateinamen eintragen. Könnt ihr mir da weiterhelfen?? Hier ist schon ein funktionsfähiger Code der die Excel Dateien zu einer Excel Datei zusammen fasst.
    Jetzt möchte ich vor jedem neuen Eintrag den entsprechenden Dateinamen stehen haben.

    Ich danke euch schon einmal.

    Code:
    Sub Zusammenführen()
        
         Dim i               As Long
         Dim sPfad           As String
         Dim sDatei          As String
         Dim vFileToOpen     As Variant
         Dim lngLZ           As Long
         Dim blnÜberschrift  As Boolean
         Dim iCalc           As Integer
         
         With ActiveSheet
            If .FilterMode Then .ShowAllData
         End With
         
         vFileToOpen = Application.GetOpenFilename(Excel Files (*.xls*), *.xls*, , , , True)
         If Not IsArray(vFileToOpen) Then Exit Sub
         
             
         iCalc = Application.Calculation
    
         On Error GoTo ENDE:
         Application.ScreenUpdating = False
         Application.Calculation = xlCalculationManual
         Application.EnableEvents = False
         
         
         For i = 1 To UBound(vFileToOpen)
             sDatei = Dir(vFileToOpen(i))
             sPfad = Left(vFileToOpen(i), InStr(vFileToOpen(i), sDatei) - 1)
         
             With Tabelle5.Range(B9)
                 .Formula = =LOOKUP(9,1/(' & sPfad & [ & sDatei & ]Tabelle5'!$B:$B<>),ROW(' & sPfad & \[ & sDatei & ]Tabelle5'!$B:$B))
                 lngLZ = .Value
             End With
             
             With Tabelle5
                 If blnÜberschrift Then
                     .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Resize(lngLZ - 1, 13).Formula = _
                     =' & sPfad & [ & sDatei & ]Tabelle5'!B9
                 Else
                     blnÜberschrift = True
                     .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Resize(lngLZ, 13).Formula = _
                     =' & sPfad & [ & sDatei & ]Tabelle5'!B9
                 End If
             End With
             
             Call StatusBalken(Int((i / UBound(vFileToOpen)) * 100))
         Next
         
         With Tabelle5.UsedRange
             .Copy
             .PasteSpecial xlPasteValues
             .Rows(2).Delete
         End With
         
    ENDE:
         Application.EnableEvents = True
         Application.Calculation = iCalc
         Application.ScreenUpdating = True
         If Err Then MsgBox Err.Description, , Fehler:  & Err
     End Sub
    
     Sub StatusBalken(ProzentSatz) ''ProzentSatz = Int((i / 10000) * 100)
         Dim Mess, Z, Rest
         Static oldStatusBar As Integer
         Static blnInit As Boolean
    
         If Not blnInit Then
             oldStatusBar = Application.DisplayStatusBar
             Application.DisplayStatusBar = True
         End If
         
         Mess = 
         For Z = 1 To ProzentSatz
             Mess = Mess & ChrW(Val(&H25A0))
         Next Z
         Rest = 100 - ProzentSatz
         For Z = 1 To Rest
             Mess = Mess & ChrW(Val(&H25A1))
         Next Z
         Application.StatusBar = Mess &   & ProzentSatz & %
         
         If Rest <= 0 Then
             Application.StatusBar = False
             Application.DisplayStatusBar = oldStatusBar
         End If
     End Sub
    
     
Die Seite wird geladen...

Dateinamen einfügen mit VBA - Ähnliche Themen

Forum Datum
Suche Tool, um zu lange Dateinamen zu erkennen und dann zu kürzen Software: Empfehlungen, Gesuche & Problemlösungen 4. Juni 2013
Bourne Shell - Dateinamen absplitten Windows XP Forum 21. Juni 2012
Dateinamen extraieren Windows XP Forum 20. Jan. 2012
Lange Dateinamen werden gekürzt - nervt Windows 7 Forum 13. Apr. 2011
[Linux] Dateinamenformat Linux & Andere 23. Nov. 2010