Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
888to892
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
888to892
888to892
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Pfadangabe über Auswahlfenster

Pfadangabe über Auswahlfenster
24.07.2007 08:41:03
Jens
Hallo zusammen,
ich habe des öfteren das Problem mehrere Exceldateien zu einer Datei zusammenfassen zu müssen. Dazu habe ich schon nachfolgendes Skript gefunden, dass auch funktioniert. Meine Frage wäre, ob es möglich ist die Pfadangabe zu dem Ordner über ein Auswahlfenster (Explorerfenster) laufen zu lassen so dass man nicht jedes Mal im Skript den Pfad ändern muss?
Option Explicit

Sub CopySheetFromFile()
Dim objNew As Workbook, ObjWb As Workbook
Dim objFS As FileSearch
Dim strPath As String
Dim intIndex As Integer
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
strPath = "C:\...\Daten" 'Pfad zu den Dateien - Anpassen!
Set objNew = Workbooks.Add(xlWBATWorksheet)
Set objFS = Application.FileSearch
With objFS
.NewSearch
.LookIn = strPath
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = False
If .Execute > 0 Then
For intIndex = 1 To .FoundFiles.Count
Set ObjWb = Workbooks.Open(.FoundFiles(intIndex))
ObjWb.Sheets(1).Copy after:=objNew.Sheets(objNew.Sheets.Count)
ObjWb.Close False
Set ObjWb = Nothing
Next
End If
End With
objNew.Sheets(1).Delete
ErrExit:
Set objNew = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub


9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Pfadangabe über Auswahlfenster
24.07.2007 10:20:17
volker
Hallo jens,
mit filedialog kannst du unter anderem auch den pfad auswählem so:
Dim myFD As FileDialog
Set myFD = Application.FileDialog(msoFileDialogFolderPicker)
With myFD
.Title = "Ordner auswählen!"
.ButtonName = "Weiter"
.Show
End With
MsgBox (myFD.SelectedItems(1)) 'zum anschauen
strPath = myFD.SelectedItems(1)
probiere mal ob das so geht
gruß volker.

AW: Pfadangabe über Auswahlfenster
24.07.2007 10:43:00
Jens
Hallo Volker
Danke erstmal für Deine Antwort. Ich hab Deinen Vorschlag probiert aber bekomme immer Fehlermeldungen ("Benutzerdefinierter Typ nicht definiert"). Da ich in VBA noch nicht so fit bin liegt es wahrscheinlich daran, dass ich das Skript falsch eingefügt habe. Könntest Du mir bitte zeigen wie es fertig aussehen müsste?

Anzeige
AW: Pfadangabe über Auswahlfenster
24.07.2007 11:18:56
volker
hallo jens,
also bei mir funktioniert es so:

Sub CopySheetFromFile()
Dim objNew As Workbook, ObjWb As Workbook
Dim objFS As FileSearch
Dim strPath As String
Dim intIndex As Integer
Dim myFD As FileDialog
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
Set myFD = Application.FileDialog(msoFileDialogFolderPicker)
With myFD
.Title = "Wählen Sie bitte den gewünschten Ordner aus!"
.ButtonName = "Weiter"
.Show
End With
strPath = myFD.SelectedItems(1)
Set objNew = Workbooks.Add(xlWBATWorksheet)
Set objFS = Application.FileSearch
With objFS
.NewSearch
.LookIn = strPath
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = False
If .Execute > 0 Then
For intIndex = 1 To .FoundFiles.Count
Set ObjWb = Workbooks.Open(.FoundFiles(intIndex))
ObjWb.Sheets(1).Copy after:=objNew.Sheets(objNew.Sheets.Count)
ObjWb.Close False
Set ObjWb = Nothing
Next
End If
End With
objNew.Sheets(1).Delete
ErrExit:
Set objNew = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub


man müßte nun natürlich noch nach dem filedialog abfangen ob überhaupt was ausgewählt wurde.
falls du es auch so hast kannst du mir ja mal schreiben wo die fehlermeldung kommt.
gruß Volker.

Anzeige
AW: Pfadangabe über Auswahlfenster
24.07.2007 11:50:00
Jens
hi Volker...also so hatte ich es auch probiert und jetzt nochmal dein Skript komplett kopiert. Bei mir kommt dann aber immer in der Zeile`"Dim myFD As FileDialog" die Meldung "Fehler beim Kompilieren: Benutzerdefinierter Typ nicht definiert".

AW: Pfadangabe über Auswahlfenster
24.07.2007 12:40:25
volker
hallo jens,
irgendwo glaube ich gelesen zu haben daß filedialog erst ab office xp zur verfügung steht.
vorher hat es glaube ich nur den getfilename gegeben , bei dem mußt du allerdings eine oder mehrere dateien auswählen
du könntest natürlich auch eine verzeichniss übersicht programmieren
aber ob das nun alles so stimmt was ich schreibe ?
vielleicht meldet sich jemand der sich besser auskennt wie wir beide.
viel glück.
gruß volker.

Anzeige
AW: Pfadangabe über Auswahlfenster
24.07.2007 13:14:00
Jens
Vielen Dank Volker für Deine schnelle Hilfe. Also ich hab noch etwas rumprobiert aber ich bekomme es nicht hin...Vieleicht hat noch jemand einen Lösungsvorschlag?

AW: Pfadangabe über Auswahlfenster
24.07.2007 13:39:00
Jens
Falls noch jemand eine Idee hat wie man die Pfadangabe in VBA realisieren kann würde ich mich über eine Mitteilung freuen. Ich denke mal, dass sich das Problem auch für andere Beispiele ergibt.

AW: Pfadangabe über Auswahlfenster
24.07.2007 14:59:57
Heiko
Hallo Jens,
z.B. so (eine von vielen Möglichkeiten):

Function GetFolder(Optional capt, Optional initF) As String
Dim objShell As Object, objFolder As Object, objItem As Object
Set objShell = CreateObject("Shell.Application")
With objShell
Set objFolder = .BrowseForFolder(0&, capt, 0, initF)
End With
If Not objFolder Is Nothing Then
Set objItem = objFolder.Self
GetFolder = objItem.Path
End If
End Function



Sub CopySheetFromFile()
Dim objNew As Workbook, ObjWb As Workbook
Dim objFS As FileSearch
Dim strPath As String
Dim intIndex As Integer
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
strPath = GetFolder("Wählen Sie einen Pfad aus.", "C:")
If strPath = "" Then GoTo ErrExit
Set objNew = Workbooks.Add(xlWBATWorksheet)
Set objFS = Application.FileSearch
With objFS
.NewSearch
.LookIn = strPath
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = False
If .Execute > 0 Then
For intIndex = 1 To .FoundFiles.Count
Set ObjWb = Workbooks.Open(.FoundFiles(intIndex))
ObjWb.Sheets(1).Copy after:=objNew.Sheets(objNew.Sheets.Count)
ObjWb.Close False
Set ObjWb = Nothing
Next
End If
End With
objNew.Sheets(1).Delete
ErrExit:
Set objNew = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub


Gruß Heiko
PS: Rückmeldung wäre nett !

Anzeige
AW: Pfadangabe über Auswahlfenster
24.07.2007 15:20:35
Jens
Hallo Heiko,
läuft einwandfrei! So habe ich mir das vorgestellt.
Besten Dank!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige