Pfad per VBA auslesen

Bild

Betrifft: Pfad per VBA auslesen
von: André
Geschrieben am: 09.07.2015 09:53:19

Guten Morgen,
ich habe folgendes Makro im Archiv gefunden, welches auch perfekt funktioniert.
Allerdings möchte ich den Pfad, in dem sich die Dateien befinden nicht im Makro eingeben, sondern mittels Fenster, welches sich öffnet, eingeben bzw. wie im Explorer möglich hinverzweigen. Wäre schön, wenn mir das jemand einbauen könnte.
Vielen Dank vorab und schönen Gruß
André

Sub kopieren()
'######################################################################
'Makro zum Öffnen aller Dateien eines Zielverzeichnisses
'Die Daten aus den Dateien Rapporte Tabelle1
'werden in Zieldatei (diese Datei)
'Tabelle1 Spalten A bis H kopiert.
'die Daten jeder Datei werden in eine eigene Zeile geschrieben
'######################################################################
    ' Variablen deklarieren
    Dim datei As String
    Dim pfad As String
    Dim i As Integer
    i = 1
    ' Quellordner wird festgelegt
    pfad = "c:\test\"
    ' Dateien des Quellordners ermitteln
    datei = Dir(pfad)
    ' Schleife, um jede Datei auszulesen
    Do While datei <> ""
        ' Datei öffnen (Pfad wird aus den Variablen pfad und datei zusammengesetzt
        Workbooks.Open Filename:=pfad & datei
        ' Zählvariable für die Zeilen (je Datei eine neue Zeile)
        i = i + 1
        ' Cells wird wie folgt verwendet Cells(Zeilennummer, Spaltennummer)
        ' Wenn das Makro in der Zieldatei steht, kann die Datei ThisWorkbook genannt werden.
        ' Die erste Zahl in der Klammer zeigt die Zeile, die Spalte die Spalte
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 1) = ActiveWorkbook.Sheets("Tabelle1").Cells(  _
_
13, 2)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 2) = ActiveWorkbook.Sheets("Tabelle1").Cells(  _
_
12, 8)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 3) = ActiveWorkbook.Sheets("Tabelle1").Cells(  _
_
10, 8)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 4) = ActiveWorkbook.Sheets("Tabelle1").Cells(9, _
 _
 19)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 5) = ActiveWorkbook.Sheets("Tabelle1").Cells(  _
_
51, 23)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 6) = ActiveWorkbook.Sheets("Tabelle1").Cells(  _
_
51, 24)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 7) = ActiveWorkbook.Sheets("Tabelle1").Cells(  _
_
51, 25)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 8) = ActiveWorkbook.Sheets("Tabelle1").Cells(  _
_
51, 26)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 9) = ActiveWorkbook.Sheets("Tabelle1").Cells(  _
_
51, 27)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 11) = ActiveWorkbook.Sheets("Tabelle1").Cells(  _
_
51, 28)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 12) = ActiveWorkbook.Sheets("Tabelle1").Cells(  _
_
51, 29)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 13) = ActiveWorkbook.Sheets("Tabelle1").Cells(  _
_
51, 30)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 14) = ActiveWorkbook.Sheets("Tabelle1").Cells(  _
_
51, 31)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 15) = ActiveWorkbook.Sheets("Tabelle1").Cells(  _
_
51, 32)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 16) = ActiveWorkbook.Sheets("Tabelle1").Cells(  _
_
51, 33)
        ThisWorkbook.Sheets("Tabelle1").Cells(i, 17) = ActiveWorkbook.Sheets("Tabelle1").Cells(  _
_
51, 34)
        'ThisWorkbook.Sheets("Tabelle1").Cells(i, 17) = ActiveWorkbook.Sheets("Tabelle1").Cells( _
 _
51, 35)
        ' Datei schließen, ohne Änderungen zu speichern
        ActiveWorkbook.Close savechanges:=False
        ' neue Datei aus dem Ordner lesen
        datei = Dir()
    ' Ende der Schleife
    Loop
End Sub

*******************

Bild

Betrifft: AW: Pfad per VBA auslesen
von: JoWE
Geschrieben am: 09.07.2015 10:35:16
Hallo André,
diese Funktion in ein Modul:

Function getFolderName()
     Dim AppShell As Object
     Dim BrowseDir As Variant
     Set AppShell = CreateObject("Shell.Application")
     Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
     On Error Resume Next
     getFolderName = BrowseDir.items().Item().Path
     On Error GoTo 0
 End Function
In Deinem Makro ersetzt Du pfad = "c:\test\" durch pfad = getFolderName
Gruß
Jochen

Bild

Betrifft: AW: Pfad per VBA auslesen
von: André
Geschrieben am: 09.07.2015 10:44:12
Hallo Jochen,
meinst Du so?
**************************
' Quellordner wird festgelegt

Function getFolderName()
     Dim AppShell As Object
     Dim BrowseDir As Variant
     Set AppShell = CreateObject("Shell.Application")
     Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
     On Error Resume Next
     getFolderName = BrowseDir.items().Item().Path
     On Error GoTo 0
 End Function

Pfad = getFolderName
******************************
Da bekomm ich immer eine meldung "Fehler beim kompilieren"
Gruß
André

Bild

Betrifft: AW: Pfad per VBA auslesen
von: JoWE
Geschrieben am: 09.07.2015 11:22:47
Hallo André,
vermutlich fehlt jetzt in Pfad der Backslash "\"
Ändere so: pfad = getFolderName & "\"
Gruß
Jochen

Bild

Betrifft: AW: Pfad per VBA auslesen
von: André
Geschrieben am: 09.07.2015 13:58:13
Hallo Jochen,
so sieht das Makro aus, es komtm aber immer "Fehler beim kompilieren"
Hast Du noch eine Idee?
Gruß
André


Sub kopieren()
'######################################################################
'Makro zum Öffnen aller Dateien eines Zielverzeichnisses
'Die Daten aus den Dateien Rapporte Tabelle1
'werden in Zieldatei (diese Datei)
'Tabelle1 Spalten A bis H kopiert.
'die Daten jeder Datei werden in eine eigene Zeile geschrieben
'######################################################################
    ' Variablen deklarieren
    Dim datei As String
    Dim Pfad As String
    Dim i As Integer
    i = 1
    ' Quellordner wird festgelegt
    

Function getFolderName()
     Dim AppShell As Object
     Dim BrowseDir As Variant
     Set AppShell = CreateObject("Shell.Application")
     Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
     On Error Resume Next
     getFolderName = BrowseDir.items().Item().Path
     On Error GoTo 0
 End Function

Pfad = getFolderName & "\"


datei = Dir(Pfad)

Bild

Betrifft: AW: Pfad per VBA auslesen
von: JoWE
Geschrieben am: 09.07.2015 14:15:03
eieieiei,
nein!!!
Die Funktion kommt nicht mitten in Dein Makro!!!
Sondern als selbständige Funktion in ein Modul.
Schneide den Teil von Function.. bis End Function

unbedingt wieder aus
und füge ihn hinter dein Makro als eigenständigen Teil ein
Function getFolderName()
     Dim AppShell As Object
     Dim BrowseDir As Variant
     Set AppShell = CreateObject("Shell.Application")
     Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
     On Error Resume Next
     getFolderName = BrowseDir.items().Item().Path
     On Error GoTo 0
 End Function
die Funktion ist quasi ein eigenes Makro und wird aus Deinem Makro über den Befehl pfad = getFolderName & "\" ausgeführt und gibt dann den Ordnernamen an Dein MAkro zurück.
Viel Erfolg,
Gruß
Jochen

Bild

Betrifft: AW: Pfad per VBA auslesen
von: André
Geschrieben am: 09.07.2015 14:52:12
Tschuldigung ;-(
Aber bin Laie in VBA
Wäre es nicht einfacher du stellst mir das Makro komplett ein, weil, auch wenn ich es ans Ende stelle
kommt "Fehler beim kompilieren".
Gruß
André

Bild

Betrifft: AW: Pfad per VBA auslesen
von: André
Geschrieben am: 09.07.2015 14:56:55
Hallo Jochen
hab es hinbekommen. Man muss einfach mal noch genauer hinsehen.
Danke sehr.
Gruß
André

Bild

Betrifft: AW: Pfad per VBA auslesen
von: André
Geschrieben am: 09.07.2015 15:21:10
Hallo Jochen,
habe 2 Dateien als Text. Die erste bringt Excel ohne Probleme rein, bei der zweiten, kommt die Meldung:
Exception has been thrown by the target of an invocation.
Und im makro hängt er bei:
Workbooks.Open Filename:=Pfad & datei
Dateien sind identisch????
Ich glaube ich gebs auf....
Gruß
André

Bild

Betrifft: AW: Pfad per VBA auslesen
von: André
Geschrieben am: 09.07.2015 15:36:06
Die zweite Datei ist beschädigt, deswegen funzt es nicht...

Bild

Betrifft: AW: Pfad per VBA auslesen
von: JoWE
Geschrieben am: 09.07.2015 15:36:37
Hallo André,
kannst Du die Dateien mal hochladen?
Gruß
Jochen

Bild

Betrifft: AW: Pfad per VBA auslesen
von: André
Geschrieben am: 10.07.2015 07:00:39
Hallo Jochen,
hat sich erledigt. Es funktioniert jetzt, nach mehrmaligen Test.
Danke sehr.
André

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Pfad per VBA auslesen"