Thema: BrowseForFolder unter Excel 64bit

Hallo zusammen,

ich nutze die Funktion"BrowseForFolder", die ich irgendwann einmal im Internet gefunden hatte um den Usern zu ermöglichen einen Ordner zu selektieren (und gleichzeitig den Inhalt des Ordners angezeigt bekommen. Es gibt zwar unzählige Lösungen für einen "Folder Picker", aber diese Lösung erlaubt mir einen bestehenden Pfad vorzuselektieren.

Blöderweise funktioniert die Funktion nicht wenn der User auf Excel 64 bit migriert ist (wir sind alle schon auf Windows 64bit). Excel schliesst einfach die Datei und öffnet den normalen "Öffnen" dialog, sobald das Macro SHBrowseForFolder aufrufen möchte.

Was müsste ich in meinem Code ändern (siehe Beispiel datei)
https://www.herber.de/bbs/user/177966.xlsb

Danke und Gruß

Theo

Moin Theo, :-)

... kannst du auch einen Startordner vorgeben: ;-)

Option Explicit

Public Sub Main_1()

    Dim objShell As Object

    Dim varDir As Variant

    Dim strTMP As String

    Set objShell = CreateObject("Shell.Application")

    Set varDir = objShell.BrowseForFolder(0, "Ordner", &H1 + &H20, Range("C11").Value)

    On Error Resume Next

    strTMP = varDir.Self.Path

    On Error GoTo Fin

    If strTMP <> "" And Left(strTMP, 2) <> "::" Then

        If Right(strTMP, 1) <> "\" Then strTMP = strTMP & "\"

        MsgBox strTMP

    End If

Fin:

    Set objShell = Nothing

    Set varDir = Nothing

    If Err.Number <> 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description

End Sub

Public Sub Main_2()

    Dim objFDialog As FileDialog

    Set objFDialog = Application.FileDialog(msoFileDialogFolderPicker)

    objFDialog.title = "Ordner auswählen"

    objFDialog.InitialFileName = Range("C11").Value

    If objFDialog.Show = -1 Then

        MsgBox "Ausgewählt: " & objFDialog.SelectedItems(1)

    End If

End Sub

Wobei der erste (Main_1) Code die Möglichkeit bietet, die Leute nicht über den Startordner hinauszulassen. ;-)

Wenn du es brauchen kannst, nutze es, wenn nicht - einfach weiterlesen. ;-)

Servus
Case

Hallöchen,

nur mal ganz allgemein - wer hat denn den code in Deiner Datei auf 64 bit umgestellt?
Einfach nur PrtSafe vor die Functions zu schreiben ist da reichlich ungenügend :-( Die Variablen in den API's, Typen, Konstanten und Variablen müssen auch geprüft und ggf. angepast werden. Eine Function hast Du glaube ls Sub drin, die lstr... könnten problematisch sein und auch

Vielen Dank schonmal,

das war ursprünglich mal mein Startpunkt. Leider zeigt dieser Dialog keine Inhalte der Ordner an, so dass der Ordner leer zu sein scheint.
Deshalb hatte ich seinerzeit erst mal auf den folgenden Dialog migriert, bei dem ich aber dafür keinen StartFolder vorgeben kann.

Function FolderDialogueLegacy(Msg As String) As String

    Dim bInfo As BROWSEINFO

    Dim path As String

    Dim TempStr As String

    

    Dim r As Long, x As Long, pos As Integer

    '---------------------------

    '   Root folder = Desktop

    bInfo.pidlRoot = 0&

    '---------------------------

    '   Title in the dialog

    If IsMissing(Msg) Then

        bInfo.lpszTitle = "Select a folder."

    Else

        bInfo.lpszTitle = Msg

    End If

    '---------------------------

    '   Type of directory to return

    bInfo.ulFlags = 16385                        '&H1

    '---------------------------

    '   Display the dialog

    x = SHBrowseForFolder(bInfo)

    '---------------------------

    '   Parse the result

    path = Space$(512)

    r = SHGetPathFromIDList(ByVal x, ByVal path)

    If r Then

        pos = InStr(path, Chr$(0))

        TempStr = Left(path, pos - 1)

        '----------------------------------------------------------------------------------------------

        '--- Find the position of the last backslash

        '----------------------------------------------------------------------------------------------

        pos = InStrRev(TempStr, "\")

        '----------------------------------------------------------------------------------------------

        '--- is there a "dot" after the last backslash? if yes we need to remove the filename from the string

        '----------------------------------------------------------------------------------------------

        If InStr(pos, TempStr, ".") > 0 Then

            TempStr = Left(TempStr, pos)

            MsgBox prompt:="You have selected a file rather than a folder!" & Chr(10) _

                          & "We will use the folder of the selected file: " & Chr(10) _

                          & Chr(39) & TempStr & Chr(39), Buttons:=vbOKOnly, Title:="File Folder used"

        End If

 

        FolderDialogueLegacy = TempStr

    Else

       FolderDialogueLegacy = Msg

    End If

End Function

Moin Theo, :-)

... vorgeben und nach deinen Vorstellungen anzeigen möchtest, fährst du am "einfachsten", wenn du dir einen eigenen Dialog erstellst. Also mit UserForm und einem TreeView. Da kannst du auch Dateien in den Ordnern zeigen - und trotzdem nur einen Ordner wählen lassen. ;-)

Servus
Case

Hallo Theo,

lade bitte mal die ursprünglich unter <VBA7 funktionierende Datei hoch.

Mit PtrSafe ist es nicht getan. Da u.a. in diversen Funktionen Zeiger enthalten sind müssen diese LongPtr deklariert werden.
Dann sind Variablen welche ein Listenfeld aufnehmen sollen als Long deklariert u.s.w.

Gruß Uwe