VBA Datei einlesen
03.10.2022 15:40:03
Jörg
ich habe von Excel Vba nur ein bischen Ahnung. Deshalb stelle ich hier meine Frage.
Diesen VBA Cod habe ich aus dem Internet. Er könnte auch aus diesem Forum stammen. Er macht fast genau das was ich benötige. Er liest mir sämtliche Dateien aus den Ordner die ich angebe aus, und macht einen Link auf die Datei.
Ich möchte aber nur die Dateien aus lesen, die in der Datei einen Bestimmten Text stehen hat.
Und zwar enden meine Dateien immer mit ( N.i.O.pdf oder mit i.O.pdf ) Es sind Messprotokolle. Nun möchte ich nur die N.i.O.pdf Dateien in eine Excelmappe kopieren,
Doch da Beiße ich mir die Zähne aus. Jetzt zu meiner Frage. Kann mir das jemand in den Bestehenden VBA Code einfügen. Vielleicht ein kleine Erklärung dazu.
Bedanke mich schon mal im Voraus
Gruß Jörg
Option Explicit
Sub DateienMitHyperlinkAuflisten()
'##### Hauptordner bearbeiten #####
Dim FileSystem As Object
Dim Unterordner As Object
Dim Datei As Object
Dim Zeile As Long
Dim Spalte As Long
Dim Ordner As Variant
Dim Ordner1 As Variant
Range("A1:E1000").Clear
Set FileSystem = CreateObject("Scripting.FileSystemObject")
Spalte = 2
Zeile = 1
Ordner = "C:\Users\Ghost_One\Desktop\Protokolle\07_Juli" ' "R:\CAD_Signatur"
If FileSystem.FolderExists(Ordner) Then
Set Ordner = FileSystem.Getfolder(Ordner)
Set Ordner1 = Unterordner
With ActiveSheet.Cells(1, 1)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Value = "Maschinen Nr:"
.Font.Bold = True
.Font.Size = 15
.Interior.Color = RGB(225, 225, 100)
End With
With ActiveSheet.Cells(1, 2)
.Value = Ordner
.Font.Bold = True
.Font.Size = 15
.Interior.Color = RGB(220, 220, 220)
End With
For Each Datei In Ordner.Files
Zeile = Zeile + 1
' ActiveSheet.Cells(Zeile, Spalte).Value = Datei.Name
ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(Zeile, Spalte), _
Address:=Datei.Path, TextToDisplay:=Datei.Name
Next
ListOrdner Ordner, Zeile, 1
End If
End Sub
Sub ListOrdner(Ordner, Zeile, Spalte)
'##### Unterordner bearbeiten #####
Dim FileSystem As Object
Dim Unterordner
Dim Datei
Set FileSystem = CreateObject("Scripting.FileSystemObject")
If FileSystem.FolderExists(Ordner) Then
Set Ordner = FileSystem.Getfolder(Ordner)
For Each Unterordner In Ordner.Subfolders
Zeile = Zeile + 1
With ActiveSheet.Cells(Zeile, Spalte)
'.HorizontalAlignment = xlCenter
'.VerticalAlignment = xlCenter
.Value = Unterordner.Name
.Font.Bold = True
.Font.Size = 15
.Interior.Color = RGB(220, 220, 220)
End With
For Each Datei In Unterordner.Files
Zeile = Zeile + 1
' ActiveSheet.Cells(Zeile, Spalte).Value = Datei.Name ' Nur der Datei Name als Link wenn Aktiviert
ActiveSheet.Hyperlinks.Add ActiveSheet.Cells(Zeile, Spalte), Datei
Next
ListOrdner Unterordner, Zeile, Spalte + 1
Next
End If
ActiveSheet.UsedRange.EntireColumn.AutoFit
End Sub