# ( Hilfe benötigt ) Automatische Umbenennung von Dateinamen



## Neo_84 (17. Juli 2008)

Hallo zusammen,

ich habe leider nur sehr minimalistische Kenntnisse bei der Programmierung mit VB und brauche dringend ein Lösung zu folgendem Problem:

In einem Ordner ( z.B. Dokumente ) befinden sich lauter doc-Dateien, welche in ihrer Bezeichnung eine "fortlaufende Nummer" haben ( z.B. xxxx-0001-xxxx-xxxxxx.doc ). Diese befindet sich wie im Beispiel zu sehen ab der 6ten Stelle ( Bindestrich mitgezählt ) und umfasst max. 4 Stellen.

In einem weiteren Ordner ( z.B. Formulare ) befinden sich nun pdf-Dateien welche nur mit dieser "fortlaufenden Nummer" gekennzeichnet sind ( z.B. 0001.pdf ).

Ich möchte nun, dass Excel die Bezeichnung der doc-Dateien nimmt und die entsprechende pdf-Datei ( lt. fortlaufender Nummer ) mit dieser Bezeichnung überschreibt.

Beispiel:

XXXX-0001-XXXX-XXXXXX.doc

0001.pdf  => XXXX-0001-XXXX-XXXXXX.pdf


Bis jetzt habe ich es nur geschafft den Ordnerinhalt in Excel einlesen zu lassen 

Hier mein Makro:

Sub test()
On Error Resume Next
Application.ScreenUpdating = False
Dim strLookIn As String, lngi As Long, strFileName As String, strTemp As String
Dim objFso As Object, objFolder As Object, objSubFolder As Object, objFile As Object
strLookIn = InputBox("Bitte Pfad angeben", , "Q:\Q1-Intranet")
strFileName = "*.pdf"
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.getFolder(strLookIn)
Sheets("Tabelle1").Columns(1).ClearContents
For Each objSubFolder In objFolder.SubFolders
lngi = lngi + 1
Sheets("Tabelle1").Cells(lngi, 1) = objFso.GetBaseName(objSubFolder)
Next
For Each objFile In objFolder.Files
strTemp = objFso.GetFileName(objFile)
If strTemp Like strFileName Then
lngi = lngi + 1
Sheets("Tabelle1").Cells(lngi, 1) = strTemp
End If
strTemp = vbNullString
Next
Set objFso = Nothing
Set objFolder = Nothing
Application.ScreenUpdating = True
End Sub

( Es ist natürlich nicht nötig mein bis jetzt erstelltes Makro beizubehalten! )

Es würde mich sehr freuen wenn mir jemand bei diesem Problem helfen könnte!

Mfg,

Georg


----------



## Zvoni (17. Juli 2008)

Nix hier von ist getestet. Verwendung auf eigene Gefahr!


```
Sub ReName(ByRef DocDir as string, ByRef PDFDir as String)
Dim FileName as string
Dim tmpFile() as String
Dim i as long

     FileName=Dir(DocDir & "\*.doc")
     
     If FileName<>"" then

     Do

          tmpFile=Split(FileName,".") 'Wir trennen den Dateinamen von der Endung DOC
          FileName=""
          For i=0 to Ubound(tmpFile)-1

'Hier bauen wir den Dateinamen wieder zusammen nur ohne Endung
'Ein Dateiname kann mehrere Punkte enthalten. Deshalb die Schleife
                FileName=FileName & tmpFile(i)       
          Next

          tmpFile=Split(FileName,"-")     'Wir zerpflücken den Dateinamen an den Bindestrichen

'Name As ist die VB-Anweisung eine Datei aus dem Code heraus umzubenennen
         Name PDFDir & "\" & tmpFile(1) & ".pdf" as FileName & ".pdf"

          FileName=Dir   'Hole nächstes Doc
     Loop until FileName=""
     End IF

End Sub
```

Aufruf mit ReName "c:\Dokumente","c:\Formulare" oder wie auch immer deine Ordner heissen


----------



## Neo_84 (17. Juli 2008)

Wie bereits geschrieben...meine VB-Kenntnisse sind schlecht!
Das dargelegte Makro habe ich aus einem Forum kopiert und abgeändert.

Was genau meinst du mit Aufrufen mit ReName?

Die Verzeichnisse lauten genau:


Für die doc-Dateien:
Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008

Für die pdf-Dateien:
Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008\_PDF-Dateien

Muss ich dein Makro mit meinem zusammen starten oder ist bei deinem schon alles dabei? Sorry wegen meinen "nicht" vorhandenen Kenntnissen!

Danke dir schon mal im Vorraus für dein Verständnis


----------



## Zvoni (17. Juli 2008)

Frage: Brauchst du diesen Umbenennungscode dauernd oder nur jetzt einmalig?


----------



## Neo_84 (17. Juli 2008)

Es kommen hier laufend neue doc-Dateien und dazugehörige pdf-Dateien dazu.
Deshalb wäre es von Vorteil wenn dieses Programm automatisiert werden könnte.

Soll heißen, wenn es automatisch ( evtl. täglich oder wöchentlich ) starten würde und alle neu angelegten Datein entsprechen umbenennt.

Falls dies nicht so leicht möglich ist, wäre es auch ok wenn ich das Excel-Dokument manuel starte und durchlaufen lasse!


----------



## Zvoni (17. Juli 2008)

Neo_84 hat gesagt.:


> Für die doc-Dateien:
> Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008
> 
> Für die pdf-Dateien:
> ...



Nein, dein Makro kannst du löschen



Neo_84 hat gesagt.:


> Es kommen hier laufend neue doc-Dateien und dazugehörige pdf-Dateien dazu.
> Deshalb wäre es von Vorteil wenn dieses Programm automatisiert werden könnte.
> 
> Soll heißen, wenn es automatisch ( evtl. täglich oder wöchentlich ) starten würde und alle neu angelegten Datein entsprechen umbenennt.
> ...



Hmmm, dann sollte man aber noch einen Test einbauen, ob eine PDF-Datei bereits umbenannt worden ist, ansonsten werden bereits umbenannte wieder umbenannt.

OK!
In Excel:
Spring im Visual Basic Editor in die Code-Ebene von "DieseArbeitsmappe" (Doppelclick drauf). Wähle dort das Objekt "Workbook" aus (linkes DropDown-Feld). Normalerweise solltest du jetzt folgenden Funktionsrumpf sehen:

```
Private Sub Workbook_Open()

End Sub
```

In diesen Funktionsrumpf trägst du jetzt wie folgt ein, damit er dann hinterher so aussieht:

```
Private Sub Workbook_Open()

ReName "Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008","Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008\_PDF-Dateien"

End Sub
```

Unterhalb diese Funktion (unter dem "End Sub") kopierst du meine Funktion von oben rein. Der vollständige Code innerhalb von DieseArbeitsmappe sieht dann so aus:

```
Private Sub Workbook_Open()

ReName "Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008","Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008\_PDF-Dateien"

End Sub

Sub ReName(ByRef DocDir as string, ByRef PDFDir as String)
Dim FileName as string
Dim tmpFile() as String
Dim i as long

     FileName=Dir(DocDir & "\*.doc")
     
     If FileName<>"" then

     Do

          tmpFile=Split(FileName,".") 'Wir trennen den Dateinamen von der Endung DOC
          FileName=""
          For i=0 to Ubound(tmpFile)-1

'Hier bauen wir den Dateinamen wieder zusammen nur ohne Endung
'Ein Dateiname kann mehrere Punkte enthalten. Deshalb die Schleife
                FileName=FileName & tmpFile(i)       
          Next

          tmpFile=Split(FileName,"-")     'Wir zerpflücken den Dateinamen an den Bindestrichen

'Name As ist die VB-Anweisung eine Datei aus dem Code heraus umzubenennen
         Name PDFDir & "\" & tmpFile(1) & ".pdf" as FileName & ".pdf"

          FileName=Dir   'Hole nächstes Doc
     Loop until FileName=""
     End IF

End Sub
```


----------



## Neo_84 (17. Juli 2008)

Okay....ich hab jetzt dein Makro eingefügt und dann über "Sub/UserForm ausführen" gestartet.

Hierbei habe ich im oberern Teil ( Workbook ) die ReName Adressen zu Testzwecken geändert und in diese Testordner ein doc bzw pdf geladen.
Jedoch wurde hierbei der Name des Pdf´s nicht geändert!

Mach ich vielleicht etwas falsch?


----------



## Zvoni (17. Juli 2008)

Bist du mal per Einzelschritt-Modus durchgegangen?


----------



## Neo_84 (18. Juli 2008)

Hab es gerade eben mit dem Einzelschrittverfahren durchlaufen lassen. 
Nach der Zeile...

Name PDFDir & "\" & tmpFile(1) & ".pdf" As FileName & ".pdf"

kommt folgende Fehlermeldung:

Laufzeitfehler '53':
Datei nicht gefunden

PS: Die PDF´s haben nicht das Format "0001.pdf" sondern "2008-0001.pdf". Die 4 Ziffern davor geben noch das Jahr an.


----------



## Zvoni (18. Juli 2008)

Neo_84 hat gesagt.:


> PS: Die PDF´s haben nicht das Format "0001.pdf" sondern "2008-0001.pdf". Die 4 Ziffern davor geben noch das Jahr an.



AHA! Wieso sagst du das nicht gleich Im ersten Post hast du das Namensformat mit 0001.pdf angegeben. Natürlich kann es ja dann nicht gehen. Nach welchem Kriterium wird das Jahr für das PDF vergeben? Kann es mehrere PDF's mit JJJJ-0001.pdf geben (Bsp. 2007-0001.pdf und 2008-0001.pdf)?


----------



## Neo_84 (18. Juli 2008)

Sorry!

Es ist so, dass im Unterordner "_PDF-Dateien" versucht wurde diese Umschreibaktion manuel durchzuführen. Es kommt somit auch vor,das PDF´s dabei sind welche bereits an das DOC-Dokument angepasst wurden oder nur teilweise umbenannt sind.

Beispiele:

2008-0028-647772-SIMAF-HA0-CAHA-vPFU.pdf

2008-0031_001.pdf

Aber alle restlichen PFD-Dateien haben folgende Bezeichnung:

2008-0001.pdf
( Jahr - fortlaufenden Nr. )


Wie im Verzeichnispfad zu sehen, gibt es für jedes Jahr einen Ordner ( zB. ...\Uber2008 ).
In den eizelnen Jahresordnern befinden sich dann immer die dazugehörigen PDF-Ordner ( z.B. ...\Uber2008\_PDF-Dateien ).

Somit befinden sich keine jahresunterschiedlichen Dokumente im gleichen Ordner!

Entschuldigung nochmals für die fehlerhaften Informationen
Ich weiß deine Hilfe wirklich zu schätzen....ich befasse mich "leider" nicht sehr intensiv mit Programmiersprachen. Mir liegt eher das Optische entwerfen ;D

Hier ein Beispiel:

http://www.tutorials.de/forum/bildbearbeitung-illustration/274753-das-stille-etwas.html

Falls du also jemals Bedarf meiner Fähigkeiten benötigtst, stehe ich dir gern zur Verfügung!


----------



## DrSoong (18. Juli 2008)

Nur so ne Verständnisfrage, wenn deine PDF-Datei z.B.


> 2008-0001.pdf


heißt, kann es dann sein, dass die dazugehörige DOC-Datei dann in der Form


> 2008-00001-XXXX-XXXX-XXXX.doc


(die Stellen nach der Zahl sind halt variabel) ist?


Der Doc!


----------



## Neo_84 (18. Juli 2008)

Ja genau das ist der Fall!

Alle DOC-Dateien haben den Anfang:

2008-0001-XXXXX-XXXXXXX-XX-XXXX-( usw ).doc


----------



## Zvoni (21. Juli 2008)

Ach so, dann müsstest du nur die Zeile


```
'Name As ist die VB-Anweisung eine Datei aus dem Code heraus umzubenennen
         Name PDFDir & "\" & tmpFile(1) & ".pdf" as FileName & ".pdf"
```

in


```
'Name As ist die VB-Anweisung eine Datei aus dem Code heraus umzubenennen
         Name PDFDir & "\" & tmpFile(0) & "-" & tmpFile(1) & ".pdf" as FileName & ".pdf"
```

umtaufen


----------



## Neo_84 (22. Juli 2008)

Also ich habe mit dieser Änderung nun keine Fehlermeldung mehr.
Jedoch waren bei einem Testlauf ( mit anderen Verzeichnissen ) die PDF´s nicht mehr im Ordner vorhanden!? Kann mir jemand sagen wohin diese PDF´s gespeichert wurden?

Um einen Testlauf zu starten habe ich folgende Änderungen im VB vorgenommen:

Vorher:

```
Private Sub Workbook_Open()

ReName "Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008","Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008\_PDF-Dateien"

End Sub
```

Nachher:

```
Private Sub Workbook_Open()

ReName "H:\WICHTIG\TEST", "H:\WICHTIG\TEST\TEST2"

End Sub
```

Nach dem Testlauf waren keine PFD´s mehr im Verzeichnis "H:\WICHTIG\TEST\TEST2" vorhanden!

Bitte um baldige Hilfe....muss diesen Vorgang dieses Woche durchführen!

mfg Georg


----------



## Zvoni (22. Juli 2008)

Neo_84 hat gesagt.:


> Also ich habe mit dieser Änderung nun keine Fehlermeldung mehr.
> Jedoch waren bei einem Testlauf ( mit anderen Verzeichnissen ) die PDF´s nicht mehr im Ordner vorhanden!? Kann mir jemand sagen wohin diese PDF´s gespeichert wurden?
> 
> Um einen Testlauf zu starten habe ich folgende Änderungen im VB vorgenommen:
> ...



Hattest du überhaupt die passenden test-Dateien schon drin?

In "H:\WICHTIG\TEST" z.B. 2008-0001-xxxxx-xxx.doc
und in "H:\WICHTIG\TEST\TEST2" die passende 2008-0001.pdf

Weil wenn im Test2-Ordner nix drin ist, kann auch nix renamed werden.


----------



## Neo_84 (22. Juli 2008)

Doch natürlich habe ich in die jeweiligen Ordner auch die jeweiligen DOC´s bzw PDF´s zu Testzwecken kopiert!

In "H:\WICHTIG\TEST" z.B. *2008-0071*-637172-SIM_HP2_1_MSV80-LO1-MANU-PFU.doc
und in "H:\WICHTIG\TEST\TEST2" die passende *2008-0071*.pdf

Insgesamt habe ich hierbei 3 DOC´s mit den dazugehörigen PFD´s bearbeitet. Jedoch waren die PFD´s vom Ordner "TEST2" nach dem Durchlaufen nicht mehr vorhanden!


----------



## Neo_84 (22. Juli 2008)

Gerade ist mir aufgefallen, dass die geänderten PDF´s nicht gelöscht wurden, sonder in den Ordner *"H:\My Documents"* verschoben werden!

Kann man dies ändern?


----------



## Zvoni (22. Juli 2008)

Neo_84 hat gesagt.:


> Gerade ist mir aufgefallen, dass die geänderten PDF´s nicht gelöscht wurden, sonder in den Ordner *"H:\My Documents"* verschoben werden!
> 
> Kann man dies ändern?



grml, kommt davon, wenn man den eigenen Code nicht testet *kopfauftischschlag*


```
'Name As ist die VB-Anweisung eine Datei aus dem Code heraus umzubenennen
         Name PDFDir & "\" & tmpFile(0) & "-" & tmpFile(1) & ".pdf" as PDFDir & "\" & FileName & ".pdf"
```

Damit müsste es jetzt klappen.


----------



## Neo_84 (22. Juli 2008)

Sorry!

Kann mir jemand vielleicht noch einen Code schreiben damit nicht vorhandene PDF´s übersprungen werden?


----------



## Zvoni (22. Juli 2008)

Neo_84 hat gesagt.:


> Sorry!
> 
> Kann mir jemand vielleicht noch einen Code schreiben damit nicht vorhandene PDF´s übersprungen werden?




```
if dir(PDFDir & "\" & tmpFile(0) & "-" & tmpFile(1) & ".pdf")<>"" then

Name PDFDir & "\" & tmpFile(0) & "-" & tmpFile(1) & ".pdf" as PDFDir & "\" & FileName & ".pdf"

End If
```

Damit wird geprüft, ob die PDF, die du umbenennen willst, überhaupt im PDF-Ordner existiert.


----------



## Neo_84 (23. Juli 2008)

Wie muss ich diese Abfrage einbauen? 

Ich bekomme im Einzelschrittverfahren in der Zeile :


```
Name PDFDir & "\" & tmpFile(0) & "-" & tmpFile(1) & ".pdf" As PDFDir & "\" & FileName & ".pdf"
```

die Fehlermeldung:

Laufzeitfehler `53`
Datei nicht gefunden

mfg,

Georg


----------



## ronaldh (23. Juli 2008)

Lass Dir doch einfach im Einzelschritt-Ablauf mal anzeigen, was in den Variablen nun drin steht, und dann schau nach, ob es diese Datei mit dem exakten Namen auch so gibt.

Wenn Dein Programm Dir sagt, dass es die Datei nicht findet, dann ist sie in aller Regel auch nicht da. Da können wir doch von hier aus auch nicht auf Deinen Rechner gucken, um die Datei zu suchen.

Mit:

```
Debug.Print PDFDir & "\" & tmpFile(0) & "-" & tmpFile(1) & ".pdf"
```
wird Dir im VB-Direktfenster angezeigt, was in der Variablen nun genau drin steht.

Grüsse
ronaldh


----------



## Zvoni (23. Juli 2008)

Einfach ein

On Error Resume Next

als erste Zeile der Sub.

Wenn der Fehler 53 ausgelöst wird, weil die Datei fehlt, wird die Name As Anweisung übersprungen, und der Code setzt mit der nächsten Zeile fort


----------



## Neo_84 (23. Juli 2008)

Okay, danke! Hat super funktionniert!

Aber was jetzt noch fehlt ist, das man beim start nach dem "DOC-Verzeichnis" & "PDF-Verzeichnis" gefragt wird! Am besten durch eine normale Ordnerauswahl wie beim öffnen einer Datei. Nur das hier ein Ordner ( bzw. Verzeichnis ) ausgewählt wird!

Ist sowas möglich?

Hintergrund:

Es gibt für jedes Jahr immer neue Ordner. Dass heißt es müsst jedesmal die Zeile


```
ReName "Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008", "Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008\_PDF-Dateien"
```
umgeschrieben werden.

Gibt es eine Möglichkeit eine Abfrage des Verzeichnisses beim Start zu haben?

Das wär dann auch das letzte von mir ;D

mfg,

Georg


----------



## Zvoni (23. Juli 2008)

Neo_84 hat gesagt.:


> Okay, danke! Hat super funktionniert!
> 
> Aber was jetzt noch fehlt ist, das man beim start nach dem "DOC-Verzeichnis" & "PDF-Verzeichnis" gefragt wird! Am besten durch eine normale Ordnerauswahl wie beim öffnen einer Datei. Nur das hier ein Ordner ( bzw. Verzeichnis ) ausgewählt wird!
> 
> Ist sowas möglich?



Ist möglich! Der ganze Spass nennt sich API-Aufruf von "SHBrowseForFolder"

guggst du hier: http://www.vbarchiv.net/api/api_shbrowseforfolder.html


----------



## Neo_84 (24. Juli 2008)

Also ich  hab jetzt lange probiert und gelesen, aber ich komm nicht drauf wie ich das für mein Makro benutze bzw. eintrage! 

Was mach ich falsch?


----------



## Zvoni (24. Juli 2008)

Neo_84 hat gesagt.:


> Also ich  hab jetzt lange probiert und gelesen, aber ich komm nicht drauf wie ich das für mein Makro benutze bzw. eintrage!
> 
> Was mach ich falsch?



Den ganzen Code von der Website in ein normales Modul rein, anstatt Private kannst/musst du alles Public machen, und natürlich anstatt Command1_Click musst du natürlich den Namen deines eigenen Buttons nehmen. Die für dich interessante Variable ist RetStr, so diese eventuell Modulweit deklarieren.


----------



## Zvoni (24. Juli 2008)

Zvoni hat gesagt.:


> Den ganzen Code von der Website in ein normales Modul rein, anstatt Private kannst/musst du alles Public machen, und natürlich anstatt Command1_Click musst du natürlich den Namen deines eigenen Buttons nehmen. Die für dich interessante Variable ist RetStr, so diese eventuell Modulweit deklarieren.



Sorry, aber ich bin hier gerade auf Arbeit und kann immer nur zwischendurch reinschauen. Jetzt allerdings ein paar Anmerkungen/Änderungen zu meinem vorigen Post:

Einfach reinkopieren funktioniert natürlich nicht, da kein einziges Objekt in Excel eine hWnd-Eigenschaft hat. Lässt sich äusserst einfach umgehen:

im VB-Editor Doppelclick auf "DieseArbeitsmappe" und folgenden Code 1:1 reinsetzen:

```
Private Declare Function FindWindow Lib "user32.dll" _
  Alias "FindWindowA" ( _
  ByVal lpClassName As String, _
  ByVal lpWindowName As String) As Long

Public Function hWnd() As Long

    hWnd = FindWindow(vbNullString, Application.Caption)

End Function
```

Dann am besten ein eigenes Modul erstellen und folgenden Code reinsetzen

```
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
  Alias  "SHBrowseForFolderA" ( _
  lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  Alias  "SHGetPathFromIDListA" ( _
  ByVal pidl As Long, _
  ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
 
' Den folgenden in ein Modul einfügen
Private Declare Function SendMessage Lib "user32" _
  Alias "SendMessageA" ( _
  ByVal hwnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  lParam As Any) As Long
 
' SendMessage SHBrowseForFolder-Messages
' --------------------------------------
 
' Enabled den OK-Button, wenn lParam ungleich 0 ist,
' andernfalls wird der Button Disabled
Private Const BFFM_ENABLEOK = &H465
 
' Setzt die Selektierung auf einen Verzeichnisbaumeintrag
' lParam gibt hierbei den Pfad an und wParam muss ungleich 0 sein
Private Const BFFM_SETSELECTION = &H466
 
' Setzt den Staustext des Dialogs.
' lParam gibt den auszugebenden Text an
Private Const BFFM_SETSTATUSTEXT = &H464
 
' Callback Ereignis-Messages
' --------------------------
 
' Dialog wurde initialisiert, lParam ist 0
Private Const BFFM_INITIALIZED = 1
 
' Benutzer hat ein anderen Verzeichnisbaumeintrag gewählt
Private Const BFFM_SELCHANGED = 2
 
' (ab IE 4.0) Benutzer hat eine falsche Angabe
' in der Textbox des Dialogs gemacht
Private Const BFFM_VALIDATEFAILED = 3

Private Type BROWSEINFO
  hwndOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type
 
Private Type SHITEMID
  cbSize As Integer
  abID As String * 256
End Type
 
Private Type ITEMIDLIST
  mkid As SHITEMID
End Type
 
' Nur Computer als Auswahl erlaubt. Wenn der Anwender andere 
' Ordner markiert, kann der OK-Schalter nicht ausgewählt 
' werden.
Private Const BIF_BROWSEFORCOMPUTER = &H1000
 
' Nur Drucker als Auswahl erlaubt. Wenn der Anwender andere 
' Ordner markiert, kann der OK-Schalter nicht ausgewählt 
' werden.
Private Const BIF_BROWSEFORPRINTER = &H2000
 
' Der Dialog zeigt neben den Ordnern auch Dateien.
Private Const BIF_BROWSEINCLUDEFILES = &H4000
 
' Der Dialog zeigt keine Netzwerkordner unterhalb der
' aktuellen Domain.
Private Const BIF_DONTGOBELOWDOMAIN = &H2
 
' Nur Dateisystemobjekte als Auswahl erlaubt. Wenn der 
' Anwender andere Ordner markiert, kann der OK-Schalter 
' nicht ausgewählt werden.
Private Const BIF_RETURNFSANCESTORS = &H8
 
' Nur Dateisystemordner als Auswahl erlaubt. Wenn der
' Anwender andere Ordner markiert, kann der OK-Schalter
' nicht ausgewählt werden.
Private Const BIF_RETURNONLYFSDIRS = &H1
 
' Der Dialog enthält eine Statuszeile. Die Rückruffunktion
' kann die Statuszeile ausfüllen
Private Const BIF_STATUSTEXT = &H4
 
' (Win 2000) Zeigt ein neuen Dialog an mit mehr
' benutzerfreundlichen Änderungen
Const BIF_USENEWUI = &H40
 
' (ab IE 4.0) Sendet an die Callback Funktion eine
' BFFM_VALIDATEFAILED Message, wenn in der Textbox eine falsche
' Eingabe gemacht wurde
Const BIF_VALIDATE = &H20
 
Private Const BIF_EDITBOX = &H10

Public Function BrowseFolder(ByVal WindowHandle as Long) as String
  Dim BI As BROWSEINFO
  Dim Item As ITEMIDLIST
  Dim Retval As Long
  Dim RetStr As String * 256
 
  ' Dialog-Eigenschaften und Vorgabewerte setzen
  With BI
    .hwndOwner = WindowHandle
    .pszDisplayName = Space(260)
    .lpszTitle = "Ordner wählen"
    .ulFlags = BIF_RETURNONLYFSDIRS Or BIF_VALIDATE Or _
      BIF_STATUSTEXT Or BIF_EDITBOX 
    .lpfn = 0
  End With
 
  ' Dialog aufrufen
  Retval = SHBrowseForFolder(BI)
  If Retval = 0 Then
    MsgBox "Es ist ein Fehler aufgetreten oder Sie haben " & _
      " auf 'Abbrechen' geklickt."
    Exit Function
  End If
 
  ' Ausgewählten Pfad ermitteln
  Retval = SHGetPathFromIDList(Retval, RetStr)
  If Retval = 0 Then
    MsgBox "Fehler beim Extrahieren des ausgewählten Pfades"
    Exit Function
  End If
 
  BrowseFolder=Left$(RetStr, InStr(1, RetStr, vbNullChar) - 1)
 
  ' Ressourcen wieder freigeben
  CoTaskMemFree Retval
End Function
```

Der Aufruf erfolgt dann mit:

Dim DOCDir as String
Dim PDFDir as String

DOCDir=BrowseFolder(DieseArbeitsmappe.hWnd)
PDFDir=BrowseFolder(DieseArbeitsmappe.hWnd)

EDIT: Ich hab eben das ganze Callback-Gedöns rausgeworfen, da man es hierfür nicht wirklich braucht


----------

