CorelScriptTools.GetFolder() question

Hopefully this is a simple problem. I am writing a macro for Photo-Paint v17 and need the user to choose a folder in which I should place the output that my macro creates. I am trying to use the CorelScriptTools.GetFolder() method. When I run even the simplest code from the documentation:

Private Sub CommandButton1_Click()
DirName$ = CorelScriptTools.GetFolder("c:\")
End Sub

I receive Run-Time error 445 Object Doesn't support this action.

I am able to use other corelscriptools without any issues. I would appreciate any assistance with this.

Thanks

0 Shelby Moore over 8 years ago

bobr3940,

GetFolder has never been implemented, you would need to do a little API magic. This should do the trick for you:

#If VBA7 Then
    Private Type BROWSEINFO
        hOwner As LongPtr
        pidlRoot As LongPtr
        pszDisplayName As String
        lpszTitle As String
        ulFlags As Long
        lpfn As LongPtr
        lParam As LongPtr
        iImage As Long
    End Type
                        
    Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
        (lpBrowseInfo As BROWSEINFO) As LongPtr
        
    Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
        (ByVal pidl As LongPtr, ByVal pszPath As String) As Boolean
#Else
    Private 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
                        
    Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
        (lpBrowseInfo As BROWSEINFO) As Long
        
    Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
        ByVal pidl As Long, ByVal pszPath As String) As Long
#End If

Function GetFolder() As String
    Dim bInfo As BROWSEINFO
    Dim Path As String
    Dim pos As Integer
    
    #If VBA7 Then
        Dim pidl As LongPtr
    #Else
        Dim pidl As Long
    #End If
    
    Path = ""
    bInfo.pidlRoot = 0
    bInfo.lpszTitle = "Select a folder"
    bInfo.ulFlags = 1
    pidl = SHBrowseForFolder(bInfo)
    If pidl <> 0 Then
        Path = Space$(512)
        If SHGetPathFromIDList(pidl, Path) Then
            pos = InStr(Path, Chr$(0))
            Path = Left$(Path, pos - 1)
        Else
            Path = ""
        End If
    End If
    GetFolder = Path
End Function

Sub TestMe()
    strFolder$ = GetFolder()
    MsgBox strFolder
End Sub

Best of luck and hope that helps,

-Shelby