Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
412to416
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
412to416
412to416
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Ist hier eine Pfadvorgabe möglich?

Ist hier eine Pfadvorgabe möglich?
Christian
Hallo Excel- Fans,
möchte diese Funktion mit einer Pfadvorgabe belegen.
z.B. K:\pfad\
um dort auf die Unterverzeichnisse zugreifen zu können.
Ist dies möglich ?
Ansonsten wird mir der "ganze Computer" angezeigt.

Sub Verzeichnis_Auswahl() Dim objShell As Object, objFolder As Object, strPfad As Variant Set objShell = CreateObject("Shell.Application") With objShell Set objFolder = .BrowseForFolder(0&, "Ordner wählen oder anlegen...", 0, 17) End With On Error Resume Next VerzPfad = objFolder.Title If Not IsEmpty(VerzPfad) Then MsgBox VerzPfad End Sub
AW: Ist hier eine Pfadvorgabe möglich?
Ulf
Nö, du kannst den lezten Parameter(hier 17) verändern, dann bekommst du eine
ander Voreinstellung. Ein bestimmter Ordner ist aber nicht möglich.
Ulf
AW: Ist hier eine Pfadvorgabe möglich?
Josef
Hallo Christian!
Um ein Verzeichniss vorzugeben könntest du diesen
Code benutzen!
'Created By Chip Pearson and Pearson Software Consulting Services
'© Copyright 1997-2003 Charles H. Pearson
' http://www.cpearson.com/excel/BrowseFolder.htm
Option Explicit
'Using the Shell Controls Library
'
'First you need to set a reference to the "Microsoft Shell
'Controls And Automation" object library.
'In the VBA Editor, go to the Tools menu, choose References,
'and scroll down to this item and put a check next to it.
'
'Then, copy the following code to a standard code module:
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260

Function BrowseFolder(Optional Caption As String, _
Optional InitialFolder As String) As String

Dim SH As Shell32.Shell
Dim F As Shell32.Folder
Set SH = New Shell32.Shell
Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, _
InitialFolder)
If Not F Is Nothing Then
BrowseFolder = F.Items.Item.Path
End If
End Function
'You can the call the BrowseFolder function with the following code:

Sub OpenFolder()
Dim FName As String
FName = BrowseFolder("Select a folder", "C:\")
If FName = "" Then
MsgBox "You didn't select a folder"
Else
MsgBox "You selected: " & FName
End If
End Sub

Gruß Sepp
Anzeige
AW: Ist hier eine Pfadvorgabe möglich?
Christian
Hallo Josef Ehrensberger,
vielen Dank, das Programm funktioniert, nach Einrichtung des Verweises!
Gibt es eventuell eine Routine, mit der ich die im Unterverzeichnis enthaltenen Dateien auflisten kann ?
Grüsse Christian

AW: Ist hier eine Pfadvorgabe möglich?
Josef
Hallo Christian!
Folgender Code in verbindung mit BROWSEFOLDER
listet alle unterordner auf (MsgBox).
Das kannst du sicher anpassen!

Sub ReverseFolders()
'von Hans W. herber
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
ShowSubFolders FSO.GetFolder(BrowseFolder("Select a folder", "C:\"))
End Sub

Sub ShowSubFolders(Folder)
Dim Subfolder As Object
For Each Subfolder In Folder.SubFolders
MsgBox Subfolder.Path
ShowSubFolders Subfolder
Next
End Sub

Gruß Sepp
Anzeige
AW: Ist hier eine Pfadvorgabe möglich?
Christian
Hi Josef,
leider kann ich dieses weitere Programm nicht anpassen.
Für mich wäre sinnvoll, wenn ich aus dem von Dir zugeschickten erstem Programm eine Dateiauswahl generieren könnte. Mir ist ansonsten kein zuverlässiger Dialog bekannt, mit dem ich eine Dateiauswahl in Excel 2000 generieren könnte (mit Pfadvorgabe). Bin leider kein Profi-Programmierer.
Vielen Dank nochmals
Christian
AW: Ist hier eine Pfadvorgabe möglich?
K.Rola
Hallo,
du musst nichts generieren, alles schon eingebaut, versuchs mal so:
Option Explicit

Sub GetOpen_FileName()
Dim DNamen As Variant, D As Long
ChDrive "C"
ChDir "C:\Eigene Dateien\"
arrDNamen = Application.GetOpenFilename _
("Excel Arbeitsmappen (*.xls), *.xls", Title:="trau dich...")
If DNamen = False Then Exit Sub
Workbooks.Open DNamen
End Sub

Gruß K.Rola
Anzeige
Oops, Schreibfehler...
K.Rola
Option Explicit

Sub GetOpen_FileName()
Dim DNamen As Variant
ChDrive "C"
ChDir "C:\Eigene Dateien\"
DNamen = Application.GetOpenFilename _
("Excel Arbeitsmappen (*.xls), *.xls", Title:="trau dich...")
If DNamen = False Then Exit Sub
Workbooks.Open DNamen
End Sub

Gruß K.Rola
AW: Oops, Schreibfehler...
20.04.2004 19:52:48
Christian
Hallo K. Rola,
vielen Dank für das Programm. Habe es gerade getestet.
Es funktioniert.
Grüsse Christian
AW: Ist hier eine Pfadvorgabe möglich?
Josef
Hallo Christian!
Das geht aber einfacher!
Option Explicit

Sub DateiOEffnen()
Dim sPath As String
Dim sFile As String
'InputBox zur Verzeichnisauswahl
sPath = InputBox("Bitte Verzeichnis auswählen!", "Verzeichnis", "D:\Office")
If sPath = "" Then Exit Sub 'wenn kein Verzeichnis angegeben dann Ende
If Right(sPath, 1) = "\" Then
sPath = Left(sPath, Len(sPath) - 1)
End If
If fncIfFolderExists(sPath) Then 'Prüfen ob Verzeichnis existiert
ChDir sPath
Else
MsgBox "Verzeichnis nicht gefunden!"
Exit Sub
End If
'Dialog zur Dateiauswahl
sFile = Application.GetOpenFilename("Excel Files (*.xls;*.xlt;*.xla), *.xls;*.xlt;*.xla")
If Dir(sFile) = "" Then
Beep
MsgBox "Datei wurde nicht gefunden!"
Exit Sub
End If
Workbooks.Open sFile
End Sub

Private Function fncIfFolderExists(sFolder As String) As Boolean
Dim sOld As String
sOld = CurDir
On Error Resume Next
ChDrive Left(sFolder, 1)
ChDir sFolder
If Err = 0 Then fncIfFolderExists = True
On Error GoTo 0
ChDrive Left(sOld, 1)
ChDir sOld
End Function

Gruß Sepp
Anzeige
Oups.... zu spät! o.T.
Josef
Gruß Sepp
AW: Oups.... auch ein Fehler!
18.04.2004 22:31:05
Josef
So muss es sein!

Sub DateiOEffnen()
Dim sPath As String
Dim sFile As String
'InputBox zur Verzeichnisauswahl
sPath = InputBox("Bitte Verzeichnis auswählen!", "Verzeichnis", "D:\Office")
If sPath = "" Then Exit Sub 'wenn kein Verzeichnis angegeben dann Ende
If Right(sPath, 1) = "\" Then
sPath = Left(sPath, Len(sPath) - 1)
End If
If fncIfFolderExists(sPath) Then 'Prüfen ob Verzeichnis existiert
ChDrive Left(sPath, 1)
ChDir sPath
Else
MsgBox "Verzeichnis nicht gefunden!"
Exit Sub
End If
'Dialog zur Dateiauswahl
sFile = Application.GetOpenFilename("Excel Files (*.xls;*.xlt;*.xla), *.xls;*.xlt;*.xla")
If Dir(sFile) = "" Then
Beep
MsgBox "Datei wurde nicht gefunden!"
Exit Sub
End If
Workbooks.Open sFile
End Sub

Gruß Sepp
Anzeige
AW: Oups.... zu spät! o.T.
20.04.2004 20:06:55
Christian
Hi Sepp,
habe Dein Programm gerade getestet.
Funktioniert!
Werde mal ein bisschen weiterprogrammieren.
Vielen Dank
Christian

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige