Office: (Office 2016) Daten von mehreren Dateien aus verschiedenen Verzeichnissen auslesen

michael887 · 31. Oktober 2020

Hier der Code:

Code:

Option Explicit

Sub main()
Call DurchSuche("C:UsersMichaelDesktopbewerbungreal")
End Sub

Sub DurchSuche(ByVal sOrdner As String)

Dim vDatei As Object
Dim vUnterOrdner As Object

With CreateObject(class:="Scripting.FileSystemObject").GetFolder(sOrdner)

For Each vUnterOrdner In .SubFolders
'*** Durchsuche Unterordner
Call DurchSuche(vUnterOrdner)
Next vUnterOrdner

'*** Zugriff auf Dateien im jeweiligen Ordner
For Each vDatei In .Files
Debug.Print vDatei.Path
Next vDatei

End With

End Sub

Sub Bereich_auslesen()
'** Dimensionierung der Variablen
Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object

'** Angaben zur auszulesenden Zelle
pfad = "C:UsersMichaelDesktopbewerbungreal"
datei = "Import XLS - Kopie.xlsm"
blatt = "Tabelle1"
Set bereich = Range("A1:A4")

'** Bereich auslesen
For Each zelle In bereich

'** Zellen umwandeln
zelle = zelle.Address(False, False)

'** Eintragen in Bereich
ActiveSheet.Cells(zelle.Row, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
Next zelle

End Sub
Private Function GetValue(pfad, datei, blatt, zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen

'*** Dimensionierung der Variablen
Dim arg As String

'Sicherstellen, dass das datei vorhanden ist
If Right(pfad, 1) "" Then pfad = pfad & ""
If Dir(pfad & datei) = "" Then
GetValue = "datei Not Found"
Exit Function
End If

'** Das Argument erstellen
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , xlR1C1)

'** Auslesen über Excel4Macro
GetValue = ExecuteExcel4Macro(arg)

End Function

Sub Bereich_auslesen1()
'** Dimensionierung der Variablen
Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object

'** Angaben zur auszulesenden Zelle
pfad = "C:UsersMichaelDesktopbewerbungreal"
datei = "Import XLS.xlsm"
blatt = "Tabelle1"
Set bereich = Range("B1:B1")

'** Bereich auslesen
For Each zelle In bereich

'** Zellen umwandeln
zelle = zelle.Address(False, False)

'** Eintragen in Bereich
ActiveSheet.Cells(zelle.Row, zelle.Column).Value = GetValue1(pfad, datei, blatt, zelle)
Next zelle

End Sub
Private Function GetValue1(pfad, datei, blatt, zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen

'*** Dimensionierung der Variablen
Dim arg As String

'Sicherstellen, dass das datei vorhanden ist
If Right(pfad, 1) "" Then pfad = pfad & ""
If Dir(pfad & datei) = "" Then
GetValue1 = "datei Not Found"
Exit Function
End If

'** Das Argument erstellen
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , xlR1C1)

'** Auslesen über Excel4Macro
GetValue1 = ExecuteExcel4Macro(arg)

End Function
Sub Bereich_auslesen3()
'** Dimensionierung der Variablen
Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object

'** Angaben zur auszulesenden Zelle
pfad = "C:UsersMichaelDesktopbewerbungrealTescht"
datei = "Import XLS22.xlsm"
blatt = "Tabelle1"
Set bereich = Range("C1:C4")

'** Bereich auslesen
For Each zelle In bereich

'** Zellen umwandeln
zelle = zelle.Address(False, False)

'** Eintragen in Bereich
ActiveSheet.Cells(zelle.Row, zelle.Column).Value = GetValue2(pfad, datei, blatt, zelle)
Next zelle

End Sub
Private Function GetValue2(pfad, datei, blatt, zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen

'*** Dimensionierung der Variablen
Dim arg As String

'Sicherstellen, dass das datei vorhanden ist
If Right(pfad, 1) "" Then pfad = pfad & ""
If Dir(pfad & datei) = "" Then
GetValue2 = "datei Not Found"
Exit Function
End If

'** Das Argument erstellen
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , xlR1C1)

'** Auslesen über Excel4Macro
GetValue2 = ExecuteExcel4Macro(arg)

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wie kann ich die ausgelesenen Daten in von mir definierten Zellen übertragen?

knobbi38 · 31. Oktober 2020

Anscheinend geht es jetzt hier weiter:
https://www.ms-office-forum.net/foru...d.php?t=370830

michael887 · 31. Oktober 2020

Hi,

funktioniert jetzt alles prima. Würd jetzt gerne die ausgelesenen Daten in von mir definierten Zellen Speichern.
Vielen Dank vorab!

Kann mir hierbei jemand weiterhelfen?

Code:

Option Explicit

Sub main()
Call DurchSuche("C:UsersMichaelDesktopbewerbungreal")
End Sub

Sub DurchSuche(ByVal sOrdner As String)

Dim vDatei As Object
Dim vUnterOrdner As Object

With CreateObject(class:="Scripting.FileSystemObject").GetFolder(sOrdner)

For Each vUnterOrdner In .SubFolders
'*** Durchsuche Unterordner
Call DurchSuche(vUnterOrdner)
Next vUnterOrdner

'*** Zugriff auf Dateien im jeweiligen Ordner
For Each vDatei In .Files
Debug.Print vDatei.Path
Next vDatei

End With

End Sub

Sub Bereich_auslesen()
'** Dimensionierung der Variablen
Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object

'** Angaben zur auszulesenden Zelle
pfad = "C:UsersMichaelDesktopbewerbungreal"
datei = "Import XLS - Kopie.xlsm"
blatt = "Tabelle1"
Set bereich = Range("A1:A4")

'** Bereich auslesen
For Each zelle In bereich

'** Zellen umwandeln
zelle = zelle.Address(False, False)

'** Eintragen in Bereich
ActiveSheet.Cells(zelle.Row, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
Next zelle

End Sub
Private Function GetValue(pfad, datei, blatt, zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen

'*** Dimensionierung der Variablen
Dim arg As String

'Sicherstellen, dass das datei vorhanden ist
If Right(pfad, 1) "" Then pfad = pfad & ""
If Dir(pfad & datei) = "" Then
GetValue = "datei Not Found"
Exit Function
End If

'** Das Argument erstellen
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , xlR1C1)

'** Auslesen über Excel4Macro
GetValue = ExecuteExcel4Macro(arg)

End Function

Sub Bereich_auslesen1()
'** Dimensionierung der Variablen
Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object

'** Angaben zur auszulesenden Zelle
pfad = "C:UsersMichaelDesktopbewerbungreal"
datei = "Import XLS.xlsm"
blatt = "Tabelle1"
Set bereich = Range("B1:B1")

'** Bereich auslesen
For Each zelle In bereich

'** Zellen umwandeln
zelle = zelle.Address(False, False)

'** Eintragen in Bereich
ActiveSheet.Cells(zelle.Row, zelle.Column).Value = GetValue1(pfad, datei, blatt, zelle)
Next zelle

End Sub
Private Function GetValue1(pfad, datei, blatt, zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen

'*** Dimensionierung der Variablen
Dim arg As String

'Sicherstellen, dass das datei vorhanden ist
If Right(pfad, 1) "" Then pfad = pfad & ""
If Dir(pfad & datei) = "" Then
GetValue1 = "datei Not Found"
Exit Function
End If

'** Das Argument erstellen
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , xlR1C1)

'** Auslesen über Excel4Macro
GetValue1 = ExecuteExcel4Macro(arg)

End Function
Sub Bereich_auslesen3()
'** Dimensionierung der Variablen
Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object

'** Angaben zur auszulesenden Zelle
pfad = "C:UsersMichaelDesktopbewerbungrealTescht"
datei = "Import XLS22.xlsm"
blatt = "Tabelle1"
Set bereich = Range("C1:C4")

'** Bereich auslesen
For Each zelle In bereich

'** Zellen umwandeln
zelle = zelle.Address(False, False)

'** Eintragen in Bereich
ActiveSheet.Cells(zelle.Row, zelle.Column).Value = GetValue2(pfad, datei, blatt, zelle)
Next zelle

End Sub
Private Function GetValue2(pfad, datei, blatt, zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen

'*** Dimensionierung der Variablen
Dim arg As String

'Sicherstellen, dass das datei vorhanden ist
If Right(pfad, 1) "" Then pfad = pfad & ""
If Dir(pfad & datei) = "" Then
GetValue2 = "datei Not Found"
Exit Function
End If

'** Das Argument erstellen
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Rangewe("A7").Address(, , xlR1C1)

'** Auslesen über Excel4Macro
GetValue2 = ExecuteExcel4Macro(arg)

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

michael887 · 31. Oktober 2020

Wie kann ich Daten in von mir definierten Zellen Abspeichern?

Derzeit schreibt der Code die Informationen genau dahin wo er die Infos im auszulesenden Blatt standen..

Vielen Dank vorab

Code:

Sub Bereich_auslesen3()
'** Dimensionierung der Variablen
Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object

'** Angaben zur auszulesenden Zelle
pfad = "C:UsersMichaelDesktop"
datei = "Import XLS22.xlsm"
blatt = "Tabelle1"
Set bereich = Range("C1:C4")

'** Bereich auslesen
For Each zelle In bereich

'** Zellen umwandeln
zelle = zelle.Address(False, False)

'** Eintragen in Bereich
ActiveSheet.Cells(zelle.Row, zelle.Column).Value = GetValue2(pfad, datei, blatt, zelle)
Next zelle

End Sub
Private Function GetValue2(pfad, datei, blatt, zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen

'*** Dimensionierung der Variablen
Dim arg As String

'Sicherstellen, dass das datei vorhanden ist
If Right(pfad, 1) "" Then pfad = pfad & ""
If Dir(pfad & datei) = "" Then
GetValue2 = "datei Not Found"
Exit Function
End If

'** Das Argument erstellen
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Rangewe("A7").Address(, , xlR1C1)

'** Auslesen über Excel4Macro
GetValue2 = ExecuteExcel4Macro(arg)

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Office: (Office 2016) Daten von mehreren Dateien aus verschiedenen Verzeichnissen auslesen

Daten von mehreren Dateien aus verschiedenen Verzeichnissen auslesen

Daten von mehreren Dateien aus verschiedenen Verzeichnissen auslesen

Daten von mehreren Dateien aus verschiedenen Verzeichnissen auslesen

Daten von mehreren Dateien aus verschiedenen Verzeichnissen auslesen - Similar Threads - Daten mehreren Dateien

Daten aus mehreren Dateien zusammenführen in einer Tabelle

Daten mehrerer Excel Dateien in eine Zieldatei kopieren

mehrere Anwender sollen per Makro Daten in freigegener Datei speichern

Mehrere Sheetsinhalte in eine Auswertungstabelle (Datei!) zur Berechnung importieren.

Zusammenführen mehrerer Dateien mit XML-Daten

Daten aus mehreren gleichen Dateien untereinander anfügen

Daten variierender Zeilenanzahlen aus mehreren Dateien holen