Pfad abfragen

Forumthread: Pfad abfragen

Pfad abfragen

Sascha

Hallo zusammen,
ich habe mir ein Makro gebastelt, welches alle Exceldateien in einem bestimmten Ordner nacheinander öffnet, jeweils bestimmte Werte entnimmt und in einer neuen Datei konsolidiert. Klappt auch alles super soweit.
Den Pfad zu den Exceldateien habe ich im Makro mit folgendem Befehl hinterlegt:
'Laufwerk und Pfad anpassen
ChDrive "C"
ChDir "C:\Documents and Settings\daten\"
strDatei = Dir("C:\Documents and Settings\daten\*.xls")
Da nicht jeder seine Daten dort speichert, wo ich das tue, hätte ich gerne eine Abfrage vorgeschaltet, die erfragt, in welchem Ordner die zu öffnenden Excel-Dateien liegen. Dieser Pfad soll dann in ChDir und strDatei übernommen werden.
Hat einer eine Ahnung, wie ich das anstellen kann?
Besten Dank und Gruß
Sascha

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Pfad abfragen

01.03.2010 14:43:08

welga

Hallo,
versuch es doch mal so:
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad _ definieren", "C:\Documents and Settings\daten")
If Suchpfad = "" Then Exit Sub
Dateiform = InputBox("Bitte die Endung der Dateiform definieren", "Dateierweiterung", "xls")
If Dateiform = "" Then Exit Sub
With Application.FileSearch
.LookIn = Suchpfad
.SearchSubFolders = True
.Filename = Dateiform
If .Execute() > 0 Then
totFiles = .FoundFiles.Count
For lngCount = 1 + a To totFiles
varDateiname = .FoundFiles(lngCount)
If varDateiname <> False Then
......
Gruß
welga

AW: Pfad abfragen

02.03.2010 08:31:57

Sascha

Hallo welga,
danke für deine Antwort.
Leider sagt er mir direkt beim Kompilieren "Fehler beim Kompilieren: If-Block ohne End If"
Wo muss ich das End If setzen?
Gruß und Dank
Sascha

AW: Pfad abfragen

02.03.2010 13:47:43

welga

Hallo,
da ich dein Makro nicht kenne, musst du meins nur als Anregung ansehen. Wenn du deins mal hochlädst, oder eine Bsp.-Mappe, dann kann ich es eventuell in deins einbinden.
nun mal zum direkten probieren, ob es von der Art das ist, was du dir vorgestellt hast.

Sub eingabe()
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad _ definieren", _
"C:\Documents and Settings\daten")
If Suchpfad = "" Then Exit Sub
Dateiform = InputBox("Bitte die Endung der Dateiform definieren", "Dateierweiterung", "xls")
If Dateiform = "" Then Exit Sub
With Application.FileSearch
.LookIn = Suchpfad
.SearchSubFolders = True
.Filename = Dateiform
If .Execute() > 0 Then
totFiles = .FoundFiles.Count
For lngcount = 1 + a To totFiles
varDateiname = .FoundFiles(lngcount)
Next lngcount
End If
End With
End Sub

Gruß
welga

AW: Pfad abfragen

03.03.2010 10:03:49

Sascha

Hallo Welga,
vielen Dank für deine Unterstützung. Ich füge dir mal hier mein Makro ein, in welchem ich bislang den Pfad absolut angegeben habe. Vielleicht hast du eine Idee, wie ich hier deine Abfrage einrichten kann. Im Makro selbst werden noch zwei weitere Makros aufgerufen, die aber für diesen Loop hier m.E. nicht wichtig sind. Daher füge ich sie nicht an.
Gruß und Dank
Sascha
--

Sub Alledateien_Bearbeiten()
Dim strDatei As String
Dim wb As Workbook
Dim Ziel As Workbook
Set Ziel = ThisWorkbook 'für Excel Zwischenspeicherung
'Laufwerk und Pfad anpassen
ChDrive "C"
ChDir "C:\Documents and Settings\SGAADMES1\My Documents\2_fortlaufend\Priority Accounts\"
strDatei = Dir("C:\Documents and Settings\SGAADMES1\My Documents\2_fortlaufend\Priority  _
Accounts\*.xls")
Do While strDatei  ""
'Öffnen erste Datei
Set wb = Workbooks.Open(strDatei)
'Deine weiteren Befehle, zB.
ActiveSheet.Outline.ShowLevels RowLevels:=2
Cells.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Windows("mysgm_vorlage.xlsm").Activate
Sheets("Tabelle1").Select
Range("A1").Select
'Ziel.Worksheets(1).Activate 'wechselt zur Zieldatei zurück
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Call auslesen_header
Call kopieren_in_uebersicht
Sheets("Tabelle1").Select
Cells.ClearContents
Selection.Delete
'Schliessen Datei
wb.Close True
'Schauen, ob es noch weitere XLS-Dateien gibt
strDatei = Dir
Loop
Set wb = Nothing
Sheets("Übersicht").Select
Range("E2:I20").Select
Selection.NumberFormat = "#,##0"
Selection.NumberFormat = "[$$-409]#,##0"
Range("A1").Select
End Sub

AW: Pfad abfragen

04.03.2010 00:18:27

fcs

Hallo Sascha,
du kannst ein Dialogfenster zur Ordnerwahl anzeigen (funktioniert zumindest unter Excel 2007)
Gruß
Franz

Sub Alledateien_Bearbeiten()
Dim strDatei As String
Dim wb As Workbook
Dim Ziel As Workbook
Dim vPfad As Variant
Set Ziel = ThisWorkbook 'für Excel Zwischenspeicherung
'Laufwerk und Pfad anpassen
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte Verzeichnis mit Dateien wählen"
If .Show = -1 Then
vPfad = .SelectedItems(1)
Else
Exit Sub
End If
End With
ChDrive "C"
ChDir vPfad
strDatei = Dir(vPfad & "\*.xls")
'....usw.
End Sub

AW: Pfad abfragen

04.03.2010 08:22:22

welga

Hallo,
sorry hatte ich nicht mehr gesehen. Ich habe es mal versucht. Probier es mal so:

Sub Alledateien_Bearbeiten()
Dim strDatei As String, suchpfad As String, dateiform As String
Dim wb As Workbook
Dim Ziel As Workbook
Dim lngcount As Integer, totfiles As Integer
Set Ziel = ThisWorkbook 'für Excel Zwischenspeicherung
'Laufwerk und Pfad anpassen
suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad _  _
definieren", "C:\Documents and Settings\SGAADMES1\My Documents\2_fortlaufend\Priority Accounts\")
If suchpfad = "" Then Exit Sub
dateiform = InputBox("Bitte die Endung der Dateiform definieren", "Dateierweiterung", "xls") _
If dateiform = "" Then Exit Sub
With Application.FileSearch
.LookIn = suchpfad
.SearchSubFolders = True
.Filename = dateiform
If .Execute() > 0 Then
totfiles = .FoundFiles.Count
For lngcount = 1 To totfiles
strDatei = .FoundFiles(lngcount)
Do While strDatei  ""
'Öffnen erste Datei
Set wb = Workbooks.Open(strDatei)
'Deine weiteren Befehle, zB.
ActiveSheet.Outline.ShowLevels RowLevels:=2
Cells.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Windows("mysgm_vorlage.xlsm").Activate
Sheets("Tabelle1").Select
Range("A1").Select
'Ziel.Worksheets(1).Activate 'wechselt zur Zieldatei zurück
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Call auslesen_header
'Call kopieren_in_uebersicht
Sheets("Tabelle1").Select
Cells.ClearContents
Selection.Delete
'Schliessen Datei
wb.Close True
'Schauen, ob es noch weitere XLS-Dateien gibt
strDatei = Dir
Loop
Set wb = Nothing
Sheets("Übersicht").Range("E2:I20").NumberFormat = "#,##0"
Sheets("Übersicht").Range("E2:I20").NumberFormat = "[$$-409]#,##0"
Next lngcount
End If
End With
End Sub

Wichtig zu wissen ist noch, dass auch alle Unterordner durchsucht werden.
Gruß
welga

AW: Pfad abfragen

04.03.2010 09:33:09

Sascha

@ all: Vielen Dank für die Unterstützung. Es läuft prima!

Beliebteste Forumthreads (12 Monate)

Forumthread: Pfad abfragen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread