+- Office-Fragen.de (https://office-fragen.de)
+-- Forum: Microsoft Office (https://office-fragen.de/forum-1.html)
+--- Forum: Excel (https://office-fragen.de/forum-2.html)
+--- Thema: Auslese Funktion (/thread-2439.html)
Auslese Funktion - MgregB - 29.08.2019
Hallo zusammen,
ich habe soweit ein Programm geschrieben, dass In einem Ordner eine bestimmte Datei ausliest und von dieser Datei die Zelle A1 in meine Exceltabelle einfügt, ich würde gerne das Programm erweitern, dass er alle Dateien in dem Ordner ausliest und von jeder Datei die Zelle A1 in die Tabelle untereinander ab Zelle A5 einträgt hat jemand eine Tipp für mich?
Hier das Programm, dass ich zum Teil auch aus dem Forum habe:
Private Function GetValue(Pfad, Datei, Blatt, Zelle)
Dim arg As String
If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\"
If Dir(Pfad & Datei) = "" Then
GetValue = "datei Not Found"
Exit Function
End If
arg = "'" & Pfad & "[" & Datei & "]" & Blatt & "'!" & Range(Zelle).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function
Sub Auslesen()
Dim Pfad As String, Datei As String, Blatt As String, Zelle As String
Pfad = "MeinPfad"
Datei = "MeineDatei.xlsx"
Blatt = "MeinBlatt"
Zelle = "A1"
ActiveCell.Value = GetValue(Pfad, Datei, Blatt, Zelle)
End Sub
Hoffe jemand kann mir weiterhelfen...
Danke
Gruß
MgregB
RE: Auslese Funktion - maninweb - 31.08.2019
Hallo,
ungestetet, versuche mal das hier ...
Code:
Sub Auslesen()
Dim Pfad As String
Dim Datei As String
Dim Blatt As String
Dim Zelle As String
Dim Zeile As Long
Pfad = "D:\Excel\"
Blatt = "MeinBlatt"
Zelle = "A1"
Zeile = 0
Datei = Dir(Pfad & "*.xlsx")
Do
If Len(Datei) > 0 Then
Zeile = Zeile + 1
ThisWorkbook.ActiveSheet.Cells(Zeile + 4, 1).Value = GetValue(Pfad, Datei, Blatt, Zelle)
Datei = Dir()
End If
Loop While Len(Datei) > 0
End SubGruß