Dateien Auslesen

Hallo zusammen,
hier mal wieder ein kleines Excelproblemchen.
Habe mit folgendem Code mal den Gundstein für ein neues Excel Projekt gelegt und komme gerade nicht weiter

Sub AuswertungDailyReport()
    Set fs = Application.FileSearch
        With fs
            .LookIn = GetOrdner
            .FileType = msoFileTypeExcelWorkbooks
            If .Execute > 0 Then
            MsgBox "There were " & .FoundFiles.Count & " file(s) found."
                For i = 1 To .FoundFiles.Count
                    'an dieser Stelle möchte ich jede gefunde Datei öffnen und
                    'bestimmte Werte aus der Datei in meine aktuell geöffnete Mappe (wks1) kopieren
                Next i
                Else
                MsgBox "Keine Dateien im Verzeichnis gefunden!"
            End If
        End With
End Sub
Function GetOrdner(Optional ByVal def = "")
    Dim objShell As Object, objfolder As Object
    Set objShell = CreateObject("Shell.Application")
    Set objfolder = objShell.BrowseForFolder(0, "Bitte einen Ordner wählen", 0, def)
    If objfolder Is Nothing Then Exit Function
    GetOrdner = objfolder.Self.Path
End Function

Ich möchte an angegebener Stelle jede gefundene Mappe öffnen und bestimmte Werte aus ihr auslesen.
Gruß Tassos

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo TAssos
Versuche es mal so:

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Sub AuswertungDailyReport()
Dim FS
Dim I As Integer
Dim Datei As Workbook
Dim WKS As Workbook
Set WKS = ThisWorkbook
Set FS = Application.FileSearch
With FS
    .LookIn = GetOrdner
    .FileType = msoFileTypeExcelWorkbooks
    If .Execute > 0 Then
        MsgBox "There were " & .FoundFiles.Count & " file(s) found."
        For I = 1 To .FoundFiles.Count
            'an dieser Stelle möchte ich jede gefunde Datei öffnen und
            'bestimmte Werte aus der Datei in meine aktuell geöffnete Mappe (wks1) kopieren
            Set Datei = Workbooks.Open(.FoundFiles(I))
            Datei.Sheets("Tabelle1").Range("A1:A10").Copy _
                WKS.Sheets("Tabelle1").Range("A65536").End(xlUp).Offset(1, 0)
            'Erste freie in Spalte A.
            'Musst du anpassen.
            Datei.Close False
            Set Datei = Nothing
        Next I
    Else
        MsgBox "Keine Dateien im Verzeichnis gefunden!"
    End If
End With
End Sub

Function GetOrdner(Optional ByVal def = "")
Dim objShell As Object, objfolder As Object
Set objShell = CreateObject("Shell.Application")
Set objfolder = objShell.BrowseForFolder(0, "Bitte einen Ordner wählen", 0, def)
If objfolder Is Nothing Then Exit Function
GetOrdner = objfolder.Self.Path
End Function

ransi

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread