Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
940to944
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
940to944
940to944
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Auslesen eines Pfades in ein Makro

Auslesen eines Pfades in ein Makro
15.01.2008 21:08:00
Paul
Hallo,
ich habe folges Makro mit aus den Exceldateien aus Laufwerk die Tabellenblätter in die geöffnete Mappe kopiert werden:

Sub kopieren()
Const myPath = "D:\Neuer Ordner\"
Dim wbZiel As Workbook, wbQuelle As Workbook
Dim strDatei As String
strDatei = Dir(myPath & "*.xls")
Set wbZiel = Workbooks.Add
Do While strDatei  ""
Set wbQuelle = Workbooks.Open(myPath & strDatei)
wbQuelle.Sheets.Copy After:=wbZiel.Worksheets(wbZiel.Worksheets.Count)
wbQuelle.Close
Set wbQuelle = Nothing
strDatei = Dir
Loop
Set wbZiel = Nothing
End Sub


Der Pfad auf Laufwerk D kann sich aber sehr häufig ändern. Ist es möglich über ein Auswahlfeld wie ListBox den jeweils gültigen Pfad auf dem Rechner einzugebe bzw. auszuwählen und diesen in das obige Makro einlesen zu lassen. Ich muss dazu sagen, ich habe wenig bis keine Erfahrungen mit Listbox. Bitte um eure Mithilfe. Vielen Dank.

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Auslesen eines Pfades in ein Makro
15.01.2008 21:49:50
Worti
Hallo Paul,
hier mal ein Makro mit Inputboxen zur Eingabe von Pfad und Laufwerk:

Sub kopieren()
Dim wbZiel As Workbook, wbQuelle As Workbook
Dim strDatei As String, strEingabePfad As String
Dim strPfad As String
Dim strLaufwerk As String
strLaufwerk = InputBox("Bitte den Laufwerksbuchstaben eingeben!")
If strLaufwerk = "" Then
MsgBox "Kein Laufwerk vorgegeben, Code wird beendet!"
Exit Sub
End If
strEingabePfad = InputBox("Bitte den Pfad eingeben!")
If strEingabePfad = "" Then
MsgBox "Kein Pfad vorgegeben, Code wird beendet!"
Exit Sub
End If
strPfad = strLaufwerk & ":\" & strEingabePfad
If Right(strPfad, 1)  "\" Then
strPfad = strPfad & "\"
End If
strDatei = Dir(strPfad & "*.xls")
Set wbZiel = Workbooks.Add
Do While strDatei  ""
Set wbQuelle = Workbooks.Open(strPfad & strDatei)
wbQuelle.Sheets.Copy After:=wbZiel.Worksheets(wbZiel.Worksheets.Count)
wbQuelle.Close
Set wbQuelle = Nothing
strDatei = Dir
Loop
Set wbZiel = Nothing
End Sub


Gruß Worti

Anzeige
AW: Auslesen eines Pfades in ein Makro
15.01.2008 22:02:00
Paul
Hallo Worti,
das ist schon gut. Mir wäre aber eine Auswahlmöglichkeit für den PFad lieber, da später reine Excel-Anwender mit bedingten Kenntnissen an der Tabelle arbeiten. Weißt du da keine Möglichkeit?

AW: Auslesen eines Pfades in ein Makro
15.01.2008 22:39:28
Daniel
Hi
du könntest den VBA-Befehl GetOpenFilname verwenden, um den Pfad vom Anwender auswählen zu lassen.
allerdings muss der Anwender dabei auf eine beliebige Datei im Pfad klicken sonst gehts nicht.
der Code würde dazu so aussehen:

Sub kopieren()
Dim myPath As String
Dim strDatei As String
myPath = Application.GetOpenFilename
If myPath = "Falsch" Then
MsgBox ("Abbruch, kein Pfad wurde ausgewählt")
Exit Sub
End If
myPath = Left(myPath, InStrRev(myPath, "\"))
strDatei = Dir(myPath & "*.xls")
Set wbZiel = Workbooks.Add
Do While strDatei  ""
Set wbQuelle = Workbooks.Open(myPath & strDatei)
wbQuelle.Sheets.Copy After:=wbZiel.Worksheets(wbZiel.Worksheets.Count)
wbQuelle.Close
Set wbQuelle = Nothing
strDatei = Dir
Loop
Set wbZiel = Nothing
End Sub


Gruß, Daniel

Anzeige
AW: Auslesen eines Pfades in ein Makro
15.01.2008 22:47:36
Paul
Danke Daniel,
das hat mir sehr geholfen, mit dem Anklicken einer Datei kann ich arbeiten.
Gruß Paul

Ordner auswählen
15.01.2008 23:04:00
{Boris}
Hi Paul,

Option Explicit
Sub Aufruf()
Call get_Folder("Was soll ich machen?", "C:\Eigene Dateien")
End Sub
Sub get_Folder(Optional capt, Optional initF)
'Original von K.Rola
Dim objShell As Object
Dim objFolder As Object
Dim objItem As Object
Set objShell = CreateObject("Shell.Application")
With objShell
Set objFolder = .BrowseForFolder(0&, capt, &H4000 + &H200 + &H10, initF)
End With
If Not objFolder Is Nothing Then
Set objItem = objFolder.Self
MsgBox objItem.Path
End If
End Sub


Grüße Boris

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige