GetOpenFilename skal acceptere mappevalg

For hulen, da. Har ledt i ugevis, og finder nu denne:

Option Explicit
Public Type BROWSEINFO
    hOwner 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

'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) _
  As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long


Sub Test()
    Dim Msg As String
    Msg = "Please select a location for the backup."
    MsgBox GetDirectory(Msg)
End Sub

Function GetDirectory(Optional Msg) As String
    Dim bInfo As BROWSEINFO
    Dim path 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 = &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))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function

Sub Test()
    Dim Msg As String
    Msg = "Please select a location for the backup."
    MsgBox GetDirectory(Msg)
End Sub

Kunne man kalde et lidt pænere stifindervindue op, end den i koden?

Nederst på siden hvor jeg fandt koden står der:

NOTE:
If you use Excel 2002 you can prompt the user to select a directory by using the new FileDialog object. The advantage is that you can specify a starting directory.

Hvordan?

Ok, har den:

Sub UseFileDialogOpen()

    Dim lngCount As Long

    ' Open the file dialog
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = True
        .Show

        ' Display paths of each file selected
        For lngCount = 1 To .SelectedItems.Count
            MsgBox .SelectedItems(lngCount)
        Next lngCount

    End With

End Sub

Men, hvordan vælger jeg så startfolderen?

Public Sub minMakro()
Dim MinSti As String
MinSti = UseFileDialogOpen
MsgBox MinSti
End Sub

Function UseFileDialogOpen() As String
' Open the file dialog
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        UseFileDialogOpen = .SelectedItems(1)
    End With
End Function

Ja, men hvordan vælger jeg hvilken folder den skal starte i?

Function UseFileDialogOpen() As String
' Open the file dialog
    On Error GoTo Slut
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        .InitialFileName = "C:\"
        UseFileDialogOpen = .SelectedItems(1)
    End With
    Exit Function
Slut:
    UseFileDialogOpen = "Du valgte intet bibliotek"
    Err.Clear
End Function

Det virker. Put et svar, og du får en tyver.

Og tak for hjælpen.

et svar ;-))