Sub ImportDaten2()
ActiveSheet.Unprotect Password:="xxxx"
Dim oMe As Worksheet, iZeile As Long, oDatei As Object
Dim oFS As Object, wbQuelle As Workbook, sBlatt As String
Set oMe = ThisWorkbook.ActiveSheet
Const sDateiPfad As String = "Pfad vom Laufwerk"
iZeile = 19
Application.ScreenUpdating = False
Set oFS = CreateObject("Scripting.FileSystemObject")
For Each oDatei In oFS.GetFolder(sDateiPfad).Files
If InStrRev(oDatei.Name, "xlsx") Then
sBlatt = "Tabelle1"
oMe.Cells(iZeile, 2) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("C3"))
oMe.Cells(iZeile, 3) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("C5"))
oMe.Cells(iZeile, 4) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("C6"))
oMe.Cells(iZeile, 5) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("C7"))
oMe.Cells(iZeile, 6) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("C8"))
oMe.Cells(iZeile, 7) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("C9"))
oMe.Cells(iZeile, 8) = GetValue(sDateiPfad, oDatei.Name, sBlatt, Range("C10"))
oMe.Hyperlinks.Add Anchor:=oMe.Cells(iZeile, 30), Address:=sDateiPfad _
& oDatei.Name, TextToDisplay:=oDatei.Name
iZeile = iZeile + 1
End If
Next
Set oMe = Nothing: Set wbQuelle = Nothing
ActiveSheet.Protect Password:="xxxx"
End Sub
|