title image


Smiley Ordner auswählen mit Vorauswahl
Hallo







      

' In ein MODUL

Option Explicit



' Benötigte API-Deklarationen

Private Type BrowseInfo

  hWndOwner As Long

  pIDLRoot As Long

  pszDisplayName As Long

  lpszTitle As Long

  ulFlags As Long

  lpfnCallback As Long

  lParam As Long

  iImage As Long

End Type



Private Const MAX_PATH = 260

Private Const BIF_RETURNONLYFSDIRS = &H1

Private Const BFFM_SETSELECTION = &H466

Private Const BFFM_INITIALIZED = 1



Private Declare Sub CoTaskMemFree Lib "ole32.dll" _

  (ByVal hMem As Long)



Private Declare Function lstrcat Lib "kernel32" Alias _

  "lstrcatA" (ByVal lpString1 As String, _

  ByVal lpString2 As String) As Long



Private Declare Function GetActiveWindow Lib "user32" () As Long



Private Declare Function SHGetPathFromIDList Lib "shell32" ( _

  ByVal pidList As Long, _

  ByVal lpBuffer As String) As Long



Private Declare Function SHBrowseForFolder Lib "shell32" ( _

  lpbi As BrowseInfo) As Long



Private Declare Function SendMessage Lib "user32.dll" _

  Alias "SendMessageA" ( _

  ByVal hWnd As Long, _

  ByVal Msg As Long, _

  wParam As Any, _

  lParam As Any) As Long



Private m_BrowseInitDir As String



'Soll im Ordnerauswahl-Dialog z.B. das Anwendungsverzeichnis Ihres

'Programms vorselektiert werden, rufen Sie die BrowseForFolder-Funktion

'wie folgt auf:

Sub Dialog_aufrufen()

Dim sPath As String



sPath = BrowseForFolder("Bitte Ordner auswählen", "C:\temp")

If sPath <> "" Then

  MsgBox sPath

End If



End Sub



' Ordnerauswahl-Dialog mit optionaler

' Angabe eines Startverzeichnisses

Public Function BrowseForFolder(ByVal sPrompt As String, _

  Optional ByVal sInitDir As String) As String

  

  Dim nPos As Long

  Dim nIDList As Long

  Dim sPath As String

  Dim oInfo As BrowseInfo

  

  m_BrowseInitDir = sInitDir



  ' Datenstruktur füllen

  With oInfo

    .hWndOwner = GetActiveWindow()

    .lpszTitle = lstrcat(sPrompt, "")

    .ulFlags = BIF_RETURNONLYFSDIRS

    If sInitDir <> "" Then

      ' Callback-Funktionsadresse

      .lpfnCallback = FuncCallback(AddressOf BrowseCallback)

    End If

  End With



  ' Dialog anzeigen und auswerten

  nIDList = SHBrowseForFolder(oInfo)

  If nIDList Then

    sPath = String$(MAX_PATH, 0)

    Call SHGetPathFromIDList(nIDList, sPath)

    Call CoTaskMemFree(nIDList)

    nPos = InStr(sPath, vbNullChar)

    If nPos Then sPath = Left$(sPath, nPos - 1)

  End If



  BrowseForFolder = sPath

End Function



Private Function BrowseCallback(ByVal hWnd As Long, _

  ByVal uMsg As Long, _

  ByVal wParam As Long, _

  ByVal lParam As Long) As Long

 

  Select Case uMsg

    Case BFFM_INITIALIZED

      ' Start-Ordner

      Call SendMessage(hWnd, BFFM_SETSELECTION, ByVal 1&, _

        ByVal m_BrowseInitDir)

  End Select

  BrowseCallback = 0

End Function

' Hilfsfunktion für AddressOf

Private Function FuncCallback(ByVal nParam As Long) As Long

  FuncCallback = nParam

End Function 



Code eingefügt mit Syntaxhighlighter 3.0







mfg, GraFri

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: