also ich habe jetzt mal folgenden Code im Forum gefunden aber egal welches Verzeichnis ich auswähle am Ende ist die Variable immer leer.
Code:
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
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
Private Declare Function SHSimpleIDListFromPath Lib "shell32" Alias "#162" (ByVal szPath As String) As Long
Private Const BIF_DONTGOBELOWDOMAIN As Long = 2
Private Const BFFM_INITIALIZED As Long = 1
Private Const MAX_PATH As Long = 260
Private Const WM_USER As Long = &H400
Private Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100)
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
Private Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104)
Private Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Function BrowseCallBackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hWnd, BFFM_SETSELECTIONA, False, ByVal lpData)
Case Else
End Select
End Function
Private Function FARPROC(pfn As Long) As Long
FARPROC = pfn
End Function
Private Function GetPIDLFromPath(ByVal sPath As String) As Long
GetPIDLFromPath = SHSimpleIDListFromPath(StrConv(sPath, vbUnicode))
End Function
Public Function BrowseDirectory(ByVal InitialDir As String, ByVal hWnd As Long) As String
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
szTitle = "Please select a directory"
With tBrowseInfo
.hwndOwner = hWnd
.pIDLRoot = 0
.lpszTitle = szTitle
.lpfnCallback = FARPROC(AddressOf BrowseCallBackProc)
.lParam = GetPIDLFromPath(InitialDir)
End With
lpIDList = SHBrowseForFolder(tBrowseInfo) ' Bis hier alles in Ordnung meine Meinung.
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
BrowseDirectory = sBuffer
CoTaskMemFree lpIDList
Else
BrowseDirectory = InitialDir
End If
CoTaskMemFree tBrowseInfo.lParam
End Function
Sub Vrz_mit_Path()
InitialDir = ThisWorkbook.Path
pPfad = BrowseDirectory(InitialDir, hWnd)
End Sub
wenn ich es mit F8 im Einzelschritt durchgehe dann ist meiner Meinung nach bis zur Zeile : lpIDList = SHBrowseForFolder(tBrowseInfo) alles ok zumindestens steht da noch eine Zahl in der Var. lpIDList im nächsten Schritt steht dann aber bei : If (lpIDList) Then in der Var. "0" und es wird der else Zweig abgearbeitet und am Ende steht überhaupt nichts mehr in der Var. pPfad.
Kann das mal jemand nachvollziehen oder mir einen Tipp geben
wieso das nicht funktioniert.
Danke Petra