Tipp 0450 Dateinamen in Tabellenblatt ausgeben
Autor/Einsender:
Datum:
  Angie
11.05.2005
Entwicklungsumgebung:   Excel 2000
In den hier folgenden Beispielen wurde für die Ermittlung der Arbeitsmappen im vorgegebenen Verzeichnis die Funktion GetXLFiles() aus unserem Tipp Dateien in vorgegebenen Verzeichnis ermitteln verwendet. Der Code der Funktion ist hier nicht abgebildet, jedoch im Download-Beispiel enthalten.
Dateinamen inkl. Pfad in einer Spalte im Tabellenblatt ausgeben
Damit die Dateinamen im Datenfeld in das Tabellenblatt ausgegeben werden können, müssen die Daten im Datenfeld erst transponiert, also Zeilen und Spalten "vertauscht" werden.
Hier werden die Daten mit der Tabellenblattfunktion Transpose (Deutsche Bezeichnung MTRANS) transponiert. Auf Grund der Begrenzung der Anzahl der Elemente, die mit der Tabellenblattfunktion transponiert werden können, sollte die Tabellenblattfunktion nur bei kleineren Datenmengen verwendet werden.
 
Public Sub Demo_Aufruf_1()
  Dim strPath       As String
  Dim astrXLFiles() As String

  strPath = ThisWorkbook.Path

  If Len(Dir$(strPath, vbDirectory)) > 0 Then
    If GetXLFiles(astrXLFiles(), strPath, True) Then

      With ActiveWorkbook.Worksheets(1)
        .Range(.Cells(2, 1), .Cells(.Rows.Count, .Columns.Count)) _
              .Cells.Clear

        .Cells(2, 1).Resize(UBound(astrXLFiles) + 1, 1).Value = _
              Application.WorksheetFunction.Transpose(astrXLFiles)
      End With

      MsgBox CStr(UBound(astrXLFiles) + 1) & _
            " Dateien wurden gefunden!", vbInformation

      Erase astrXLFiles

    Else
      MsgBox "Keine Excel-Arbeitsmappen im Verzeichnis " & _
            vbCrLf & strPath & vbCrLf & "gefunden!", _
            vbInformation, "VB-fun-Demo"
    End If

  Else
    MsgBox "Das Verzeichnis " & vbCrLf & strPath & vbCrLf & _
          "existiert nicht!", vbInformation, "VB-fun-Demo"
  End If
End Sub
 
Das Ergebnis des folgenden Beispiels ist das selbe wie obiges Beispiel, jedoch mit dem Unterschied, dass die Daten hier "zu Fuß" mithilfe eines 2. Datenfelds transponiert werden. Die Geschwindigkeit der Code-Ausführung ist die selbe wie bei der Verwendung der Tabellenblattfunktion Transpose, hat jedoch den Vorteil, dass größere Datenmengen transponiert werden können.
 
Public Sub Demo_Aufruf_2()
  Dim strPath       As String
  Dim astrXLFiles() As String
  Dim astrXLData()  As String
  Dim nFilesCnt     As Long
  Dim nFile         As Long

  strPath = ThisWorkbook.Path

  If Len(Dir$(strPath, vbDirectory)) > 0 Then
    If GetXLFiles(astrXLFiles(), strPath, True) Then

      nFilesCnt = UBound(astrXLFiles)
      ReDim astrXLData(nFilesCnt, 0)
      For nFile = 0 To nFilesCnt
          astrXLData(nFile, 0) = astrXLFiles(nFile)
      Next

      With ActiveWorkbook.Worksheets(1)
        .Range(.Cells(2, 1), .Cells(.Rows.Count, _
              .Columns.Count)).Cells.Clear

        .Cells(2, 1).Resize(nFilesCnt + 1, 1).Value = astrXLData
      End With

      Erase astrXLData
      Erase astrXLFiles

      MsgBox CStr(nFilesCnt + 1) & " Dateien wurden gefunden!", _
            vbInformation, "VB-fun-Demo"

    Else
      MsgBox "Keine Excel-Arbeitsmappen im Verzeichnis " & _
            vbCrLf & strPath & vbCrLf & "gefunden!", _
            vbInformation, "VB-fun-Demo"
    End If

  Else
    MsgBox "Das Verzeichnis " & vbCrLf & strPath & vbCrLf & _
          "existiert nicht!", vbInformation, "VB-fun-Demo"
  End If
End Sub
 
Pfad und Dateinamen getrennt in zwei Spalten in Tabellenblatt ausgeben
Zunächst werden Pfad und Dateiname der einzelnen Dateien ermittelt und in einem zweidimensionalen Datenfeld zwischengespeichert, und anschließend in den Zellbereich eingefügt.
 
Public Sub Demo_Aufruf_3()
  Dim strPath       As String
  Dim astrXLFiles() As String
  Dim astrXLData()  As String
  Dim nFilesCnt     As Long
  Dim nFile         As Long

  Dim strFileName   As String
  Dim strFile       As String

  strPath = ThisWorkbook.Path

  If Len(Dir$(strPath, vbDirectory)) > 0 Then
    If GetXLFiles(astrXLFiles(), strPath, True) Then

      nFilesCnt = UBound(astrXLFiles)
      ReDim astrXLData(nFilesCnt, 1)

      For nFile = 0 To nFilesCnt
        strFileName = astrXLFiles(nFile)
        strFile = Dir$(strFileName)

        astrXLData(nFile, 0) = Left$(strFileName, _
              Len(strFileName) - Len(strFile))
        astrXLData(nFile, 1) = strFile
      Next

      With ActiveWorkbook.Worksheets(1)
        .Range(.Cells(2, 1), .Cells(.Rows.Count, .Columns.Count)) _
              .Cells.Clear

        .Cells(2, 1).Resize(nFilesCnt + 1, 2).Value = astrXLData
      End With

      Erase astrXLData
      Erase astrXLFiles

      MsgBox CStr(nFilesCnt + 1) & " Dateien wurden gefunden!", _
            vbInformation, "VB-fun-Demo"

    Else
      MsgBox "Keine Excel-Arbeitsmappen im Verzeichnis " & _
            vbCrLf & strPath & vbCrLf & "gefunden!", _
            vbInformation, "VB-fun-Demo"
    End If

  Else
    MsgBox "Das Verzeichnis " & vbCrLf & strPath & vbCrLf & _
          "existiert nicht!", vbInformation, "VB-fun-Demo"
  End If
End Sub
 
Weitere Links zum Thema
Dateinamen in ComboBox/ListBox auflisten
Daten in Zellen schreiben
Description of the limitations for working with arrays in Excel 2000, Excel 2002, and Excel 2003
XL: Limitations of Passing Arrays to Excel Using Automation

Windows-Version
95
98
ME
NT
2000
XP
Vista
Win 7
Excel-Version
95
97
2000
2002 (XP)
2003
2007
2010


Download  (18,1 kB) Downloads bisher: [ 710 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Mittwoch, 18. Mai 2011