VBA Dateiname auslesen

[StrammerMax]

Hallo zusammen,

ich habe hier mehrere Dateien mit Daten, die in einer "Masterdatei" alle zusammengeführt werden. Dazu wird per VBA Datei für Datei geöffnet und die entsprechenden Informationen ausgelesen. Das funktioniert soweit auch einwandfrei. 

Mein Problem ist nun Folgendes: In der Masterdatei wird in Spalte 124 der Name der Quelldatei angezeigt. Sprich aus welcher Datei der Datensatz kommt. Wenn aus einer Datei aber z.B. 5 Datensätze (Zeilen in der Masterdatei) kommen dann steht der Name der Datei nur in der ersten Zeile und nicht in allen 5 Zeilen. 

Code:

Sub Zusammenfassung_auflisten()
Dim sPfad As String, iRow As Integer
Dim Wb As Workbook, i As Integer, temp
'Ordner Pfad aus Zelle E1 laden
sPfad = Worksheets(1).Range("E1").Value
If Right(sPfad, 1) <> "\" Then sPfad = sPfad & "\"
temp = Dir$(sPfad & "*.xls*")
iRow = 5   '1.Zeile in Liste

With Worksheets(1)
'Alte Tabelle komplett löschen
.UsedRange.Offset(4, 0).ClearContents
  Application.ScreenUpdating = False

On Error Resume Next
Do While temp <> ""
    'Zusammenfassung überspringen
    If InStr(temp, "Zusammenfassung") = 0 Then
       'Quelldatei öffnen und auslesen
       Application.DisplayAlerts = False
       Err = Empty: Workbooks.Open sPfad & temp
       If Err = Empty Then
          Set Wb = ActiveWorkbook
          ' Quelle
          .Cells(iRow, 124) = temp

Was dann dabei heraus kommt ist Folgendes:

   

In Zeile 5 wird der Name der Quelldatei ausgegeben - das ist richtig. 
Aber dann kommt erst in Zeile 21 der nächste Name einer Quelldatei. 

Alle Zeilen von 5 bis einschließlich 20 gehören zur gleichen Quelle - nämlich AP. 

Wie bekomme ich es hin, dass auch in Zeile 6 bis 20 AP als Quelle steht?

[Lutz Fricke]

Hallo Max,

um Deine Frage zu beantworten müssten wir Deinen ganzen Code kennen.
Bisher sehen wir, dass Du nach dem Öffnen den Namen einmal in Spalte 124 schreibst. Aber was machst Du dann?

Gruß,
Lutz

[StrammerMax]

Code:

Option Explicit


Sub Zusammenfassung_auflisten()
Dim sPfad As String, iRow As Integer
Dim Wb As Workbook, i As Integer, temp
'Ordner Pfad aus Zelle E1 laden
sPfad = Worksheets(1).Range("E1").Value
If Right(sPfad, 1) <> "\" Then sPfad = sPfad & "\"
temp = Dir$(sPfad & "*.xls*")
iRow = 5   '1.Zeile in Liste

With Worksheets(1)
'Alte Tabelle komplett löschen
.UsedRange.Offset(4, 0).ClearContents
  Application.ScreenUpdating = False

On Error Resume Next
Do While temp <> ""
    'Zusammenfassung überspringen
    If InStr(temp, "Zusammenfassung") = 0 Then
       'Quelldatei öffnen und auslesen
       Application.DisplayAlerts = False
       Err = Empty: Workbooks.Open sPfad & temp
       If Err = Empty Then
          Set Wb = ActiveWorkbook
          ' Quelle
          .Cells(iRow, 124) = temp
          'alle Tabellen auf "Bezeichnung" und Anmerkung prüfen
          For i = 1 To Wb.Worksheets.Count
              '** "Example" überspringen!
            If Wb.Worksheets(i).Name <> "BBB" And Wb.Worksheets(i).Name <> "ZZZ" Then
            If InStr(Wb.Worksheets(i).Range("B4"), "YYY") And _
               InStr(Wb.Worksheets(i).Range("B5"), "XXX") Then
               '** Name des Formulars auflisten  (oder löschen)
               .Cells(iRow, 125).Value = Wb.Worksheets(i).Name
               'Daten des Formulars auflisten
               .Cells(iRow, 1).Value = Wb.Worksheets(i).Range("C4")
               .Cells(iRow, 2).Value = Wb.Worksheets(i).Range("D4")
               .Cells(iRow, 3).Value = Wb.Worksheets(i).Range("C5")

               [...]

               .Cells(iRow, 123).Value = Wb.Worksheets(i).Range("A3")
                iRow = iRow + 1
            End If
            End If
          Next i
          'Aktive Mappe schliessen  (ohne Speichern)
          ActiveWorkbook.Close savechanges:=False
        Else
           MsgBox temp & "  diese Datei konnte nicht geöffnet werden!"
        End If
    End If
    temp = Dir$()
Loop

Application.DisplayAlerts = True
End With
End Sub

Danach passiert für mein Verständnis nichts mehr was relevant für den ausgelesenen Dateinamen ist.

Es werden dann nur noch die benötigten Informationen ausgelesen und die Dateien wieder geschlossen.

[Lutz Fricke]

Hallo Max,

dann schiebe doch das

Code:

.Cells(iRow, 124) = temp

einfach in die Schleife. Dann druckt's den Namen auch bei jedem Schleifendurchlauf und nicht nur bei Öffnen einer neuen Datei.
Also:

Code:

          For i = 1 To Wb.Worksheets.Count
              '** "Example" überspringen!
            If Wb.Worksheets(i).Name <> "BBB" And Wb.Worksheets(i).Name <> "ZZZ" Then
            If InStr(Wb.Worksheets(i).Range("B4"), "YYY") And _
               InStr(Wb.Worksheets(i).Range("B5"), "XXX") Then
               '** Name des Formulars auflisten  (oder löschen)
               .Cells(iRow, 125).Value = Wb.Worksheets(i).Name
               .Cells(iRow,124)=temp

...

Gruß,
Lutz

[StrammerMax]

Super, vielen Dank. Das tut genau was es soll und ist eigentlich ziemlich logisch  :28: