Old VBA (32 Bit) Does Not Run on New 64 Bit

[Stuboy]

Hi 

I have an older .dvb file that use to work in 32 bit, however It doesnt work now in 64 Bit, I have limited knowledge on VBA but by changing the common dialog (Code from a post here) I was able to declare ptrsafe for functions. not my module code is not playing ball possibly due to how I am referring to a function that doesnt exist in the new 64 bit common dialog

I have attached and you will be able to see I am relying on Windows API for browsing and opening files Essentially I want to be able to browse for a script file and select,  add drawings , remove  drawings etc

Is there anyone that can get this running in 64 bit and perhaps tell me where im going wrong, code can probably be simplified?

I have attached existing code untouched as it worked in 32 and the modified 64 with new common dialog class module

Thanks a heap in advance maestros

[norman.yuan]

I took a bit time, modified your code:

1. commented out entire class CommonDialog;

2. added a new module that uses Windows API's comdialog32

3. Modified the UserForm's code for the 3 buttons' click event

The modified DVB file is attached. Give it a try. It works OK with my 64-bit AutoCAD (2018)

[norman.yuan · Accepted solution]

Well, it looks like, for some reasons, the zip attachment is not allowed on my side. SO, I copy all the code I changed here:

1. Create a new module, name it "modCommonDialog64bit" (or whatever name you choose). Copy following code into it:

''===================================================================================================================
'' Following code is copied from Autodesk discussion forum here:
'' http://forums.autodesk.com/t5/inventor-customization/folder-browser-needed-for-vba-7-64-bit/m-p/4365989#M45667
''===================================================================================================================
Option Explicit

Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
        "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias _
        "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

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

Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
        (ByVal pidList As LongPtr, ByVal lpBuffer As String) As Long


Public Declare PtrSafe Function SendMessageA Lib "user32" _
        (ByVal Hwnd As LongPtr, ByVal wMsg As Long, _
        ByVal wParam As LongPtr, lParam As Any) As LongPtr

Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As LongPtr)

Private Const BIF_RETURNONLYFSDIRS As Long = 1
Private Const CSIDL_DRIVES As Long = &H11
Private Const WM_USER As Long = &H400
Private Const MAX_PATH As Long = 260            '// message from browser
Private Const BFFM_INITIALIZED As Long = 1
Private Const BFFM_SELCHANGED As Long = 2
Private Const BFFM_VALIDATEFAILEDA As Long = 3  '// lParam:szPath ret:1(cont),0(EndDialog)
Private Const BFFM_VALIDATEFAILEDW As Long = 4  '// lParam:wzPath ret:1(cont),0(EndDialog)
Private Const BFFM_IUNKNOWN As Long = 5         '// provides IUnknown to client. lParam: IUnknown*
'// messages to browser
Private Const BFFM_SETSTATUSTEXTA As Long = WM_USER + 100
Private Const BFFM_ENABLEOK As Long = WM_USER + 101
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 Const BFFM_SETOKTEXT As Long = WM_USER + 105 '// Unicode only
Private Const BFFM_SETEXPANDED As Long = WM_USER + 106 '// Unicode only
     
Public Const OFN_ALLOWMULTISELECT As Long = &H200
Public Const OFN_CREATEPROMPT As Long = &H2000
Public Const OFN_ENABLEHOOK As Long = &H20
Public Const OFN_ENABLETEMPLATE As Long = &H40
Public Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Public Const OFN_EXPLORER As Long = &H80000
Public Const OFN_EXTENSIONDIFFERENT As Long = &H400
Public Const OFN_FILEMUSTEXIST As Long = &H1000
Public Const OFN_HIDEREADONLY As Long = &H4
Public Const OFN_LONGNAMES As Long = &H200000
Public Const OFN_NOCHANGEDIR As Long = &H8
Public Const OFN_NODEREFERENCELINKS As Long = &H100000
Public Const OFN_NOLONGNAMES As Long = &H40000
Public Const OFN_NONETWORKBUTTON As Long = &H20000
Public Const OFN_NOREADONLYRETURN As Long = &H8000& '*see comments
Public Const OFN_NOTESTFILECREATE As Long = &H10000
Public Const OFN_NOVALIDATE As Long = &H100
Public Const OFN_OVERWRITEPROMPT As Long = &H2
Public Const OFN_PATHMUSTEXIST As Long = &H800
Public Const OFN_READONLY As Long = &H1
Public Const OFN_SHAREAWARE As Long = &H4000
Public Const OFN_SHAREFALLTHROUGH As Long = 2
Public Const OFN_SHAREWARN As Long = 0
Public Const OFN_SHARENOWARN As Long = 1
Public Const OFN_SHOWHELP As Long = &H10
Public Const OFN_ENABLESIZING As Long = &H800000
Public Const OFS_MAXPATHNAME As Long = 260

'OFS_FILE_OPEN_FLAGS:
Public Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER Or _
             OFN_LONGNAMES Or _
             OFN_CREATEPROMPT Or _
             OFN_NODEREFERENCELINKS
             
Private Type OPENFILENAME
    lStructSize As Long
    hWndOwner As LongPtr
    hInstance As LongPtr
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As LongPtr
    lpTemplateName As String
End Type

Public Type BrowseInfo
    hWndOwner As LongPtr
    pIDLRoot As LongPtr
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfnCallback As LongPtr
    lParam As LongPtr
    iImage As Long
End Type
 
'====== File Browsers for 64 bit VBA 7 ========
Public Function FileBrowseOpen( _
    ByVal sInitFolder As String, _
    ByVal sTitle As String, _
    ByVal sFilter As String, _
    ByVal nFilterIndex As Integer, _
    Optional ByVal multiSelect = False) As String

    Dim OpenFile As OPENFILENAME
    Dim lReturn As Long

    sInitFolder = CorrectPath(sInitFolder)
    OpenFile.lpstrInitialDir = sInitFolder

    ' Swap filter separator for api separator
    sFilter = Replace(sFilter, "|", Chr(0))

    OpenFile.lpstrFilter = sFilter
    OpenFile.nFilterIndex = nFilterIndex
    OpenFile.lpstrTitle = sTitle
    
    
    
    OpenFile.hWndOwner = 0
    OpenFile.lpstrFile = String(257, 0)
    OpenFile.nMaxFile = LenB(OpenFile.lpstrFile) - 1
    OpenFile.lStructSize = LenB(OpenFile)
    
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
    
    If Not multiSelect Then
        OpenFile.flags = 0
    Else
        OpenFile.flags = OFS_FILE_OPEN_FLAGS + OFN_ALLOWMULTISELECT
    End If
    
    lReturn = GetOpenFileName(OpenFile)

    If lReturn = 0 Then
        FileBrowseOpen = ""
    Else
        If multiSelect Then
            Dim str As String
            str = Trim(Replace(Trim(OpenFile.lpstrFile), vbNullChar, ","))
            Dim ed As String
            ed = Mid(str, Len(str))
            While (ed = ",")
                str = Trim(Left(str, Len(str) - 1))
                ed = Mid(str, Len(str))
            Wend
            FileBrowseOpen = str
        Else
            FileBrowseOpen = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
        End If
    End If
    
End Function


Public Function GetFiles( _
    ByVal sInitFolder As String, _
    ByVal sTitle As String, _
    ByVal sFilter As String, _
    ByVal nFilterIndex As Integer) As String()

    strReturn = FileBrowseOpen(sInitFolder, sTitle, sFilter, nFilterIndex, True)
    GetFiles = Split(strReturn, ",")
    
End Function

Public Function FileBrowseSave( _
    ByVal sDefaultFilename As String, _
    ByVal sInitFolder As String, _
    ByVal sTitle As String, _
    ByVal sFilter As String, _
    ByVal nFilterIndex As Integer) As String
    
    Dim PadCount As Integer
    Dim OpenFile As OPENFILENAME
    Dim lReturn As Long

    sInitFolder = CorrectPath(sInitFolder)
    
    ' Swap filter separator for api separator
    sFilter = Replace(sFilter, "|", Chr(0))
    
    OpenFile.lpstrFilter = sFilter
    OpenFile.nFilterIndex = 1
    OpenFile.hWndOwner = 0

    PadCount = 260 - Len(sDefaultFilename)
    OpenFile.lpstrFile = sDefaultFilename & String(PadCount, Chr(0))
    'OpenFile.lpstrFile = String(257, 0)
    OpenFile.nMaxFile = LenB(OpenFile.lpstrFile) - 1
    OpenFile.lStructSize = LenB(OpenFile)
    
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
    OpenFile.lpstrInitialDir = sInitFolder
    OpenFile.lpstrTitle = sTitle
    OpenFile.flags = 0
    lReturn = GetSaveFileName(OpenFile)

    If lReturn = 0 Then
        FileBrowseSave = ""
    Else
        FileBrowseSave = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
    End If
    
End Function
 
'====== Folder Browser for 64 bit VBA 7 ========
Public Function FolderBrowse(ByVal sDialogTitle As String, ByVal sInitFolder As String) As String

    Dim ReturnPath As String
    Dim b(MAX_PATH) As Byte
    Dim pItem As Long
    Dim sFullPath As String
    Dim bi As BrowseInfo
    Dim ppidl As Long

    sInitFolder = CorrectPath(sInitFolder)

    ' Note VBA windows and dialogs do not have an hWnd property.
    bi.hWndOwner = 0 'Windows Main Screen handle.

    ' SHGetSpecialFolderLocation bi.hWndOwner, CSIDL_DRIVES, ppidl
    bi.pIDLRoot = 0 'ppidl

    bi.pszDisplayName = VarPtr(b(0))
    bi.lpszTitle = sDialogTitle
    bi.ulFlags = BIF_RETURNONLYFSDIRS
    If FolderExists(sInitFolder) Then bi.lpfnCallback = PtrToFunction(AddressOf BFFCallback)
    bi.lParam = StrPtr(sInitFolder)
    pItem = SHBrowseForFolder(bi)
    
    If pItem Then ' Succeeded
        sFullPath = Space$(MAX_PATH)
        If SHGetPathFromIDList(pItem, sFullPath) Then
            ReturnPath = Left$(sFullPath, InStr(sFullPath, vbNullChar) - 1) ' Strip nulls
        CoTaskMemFree pItem
        End If
    End If

    If ReturnPath <> "" Then
        If Right$(ReturnPath, 1) <> "\" Then
            ReturnPath = ReturnPath & "\"
        End If
    End If

    FolderBrowse = ReturnPath

End Function
' typedef int (CALLBACK* BFFCALLBACK)(HWND hwnd, UINT uMsg, LPARAM lParam, LPARAM lpData);
Private Function BFFCallback( _
    ByVal Hwnd As LongPtr, ByVal uMsg As LongPtr, _
    ByVal lParam As LongPtr, ByVal sData As String) As LongPtr
    
    If uMsg = BFFM_INITIALIZED Then
        SendMessageA Hwnd, BFFM_SETSELECTIONA, True, ByVal sData
    End If
    
End Function

Private Function PtrToFunction(ByVal lFcnPtr As LongPtr) As LongPtr
    PtrToFunction = lFcnPtr
End Function

Private Function CorrectPath(ByVal sPath As String) As String
    If Right$(sPath, 1) = "\" Then
        If Len(sPath) > 3 Then sPath = Left$(sPath, Len(sPath) - 1) ' Strip backslash from non-root
    Else
        If Len(sPath) = 2 Then sPath = sPath & "\" ' Append backslash to root
    End If
    CorrectPath = sPath
End Function

Public Function FolderExists(ByVal sFolderName As String) As Boolean
    Dim att As Long
    On Error Resume Next
    att = GetAttr(sFolderName)
    If Err.Number = 0 Then
    FolderExists = True
    Else
    Err.Clear
    FolderExists = False
    End If
    On Error GoTo 0
End Function

2. in the code for the frmMultiScript, only code for the 3 buttons' click event handling code changed:

Private Sub cmdAddDwg_Click()

''''    Dim objFile As CommonDialog, file
''''
''''    Set objFile = New CommonDialog
''''    With objFile
''''        .DialogTitle = "Select files to process: "
''''        .Filter = "AutoCAD Drawings (*.dwg)|*.dwg|" & _
''''                  "All Files (*.*)|*.*"
''''        .FilterIndex = 0
''''        .flags = OFN_ALLOWMULTISELECT Or OFN_EXPLORER Or OFN_FILEMUSTEXIST
''''        .InitDir = ThisDrawing.Path
''''        .MaxFileSize = 4096
''''        If .ShowOpen Then
''''            If Not .FileName = "" Then
''''                For Each file In .ParseFileNames
''''                    frmMultiScript.lstDwgList.AddItem file
''''                Next file
''''            End If
''''        End If
''''    End With
''''
''''    lstDwgList_Change
    Dim initFolder As String
    Dim filter As String
    Dim fileNames() As String
    Dim i As Integer
    
    initFolder = ThisDrawing.Path
    filter = "AutoCAD Drawing Files (*.dwg)|*.dwg|All Files (*.*)|*.*"
    
    fileNames = GetFiles(initFolder, "Select Drawing Files", filter, 0)
    If UBound(fileNames) > 0 Then
        For i = 1 To UBound(fileNames)
            lstDwgList.AddItem fileNames(0) & "\" & fileNames(i)
        Next
    End If
     
End Sub

and

Private Sub cmdBrowse_Click()

'''''    Dim fh As Variant
'''''    Dim tmp As String
'''''    Dim objFile As CommonDialog, file
'''''
'''''    Set objFile = New CommonDialog
'''''    With objFile
'''''        .DialogTitle = "Select AutoCAD Script (*.scr) file: "
'''''        .Filter = "AutoCAD Script Files (*.scr)|*.scr|" & _
'''''                  "All Files (*.*)|*.*"
'''''        .FilterIndex = 0
'''''        .flags = OFN_EXPLORER Or OFN_FILEMUSTEXIST
'''''        .InitDir = ThisDrawing.Path
'''''        .MaxFileSize = 4096
'''''        If .ShowOpen Then
'''''            If .FileName <> "" Then
'''''                frmMultiScript.txtScriptFileName.Text = .FileName
'''''            End If
'''''        End If
'''''    End With

    Dim scrFile As String
    Dim initFolder As String
    Dim filter As String
    
    initFolder = ThisDrawing.Path
    filter = "AutoCAD Script Files (*.scr)|*.scr|All Files (*.*)|*.*"
    
    scrFile = FileBrowseOpen(initFolder, "Select AutoCAD Script File (*.scr)", filter, 0)
    If Len(scrFile) > 0 Then
        txtScriptFileName.Text = scrFile
    End If

End Sub

and

Private Sub cmdtxt_Click()
''''Dim fh As Variant
''''Dim tmp As String
''''Dim objFile As CommonDialog, file
''''
''''    Set objFile = New CommonDialog
''''    With objFile
''''        .DialogTitle = "Select Text (*.txt) file: "
''''        .Filter = "Text Files (*.txt)|*.txt|" & _
''''                  "All Files (*.*)|*.*"
''''        .FilterIndex = 0
''''        .flags = OFN_EXPLORER Or OFN_FILEMUSTEXIST
''''        .InitDir = ThisDrawing.Path
''''        .MaxFileSize = 4096
''''        If .ShowOpen Then
''''            If .FileName <> "" Then
''''                fh = FreeFile
''''                Open .FileName For Input As #fh
''''
''''                Do While Not EOF(fh)
''''                    Line Input #fh, tmp
''''                    frmMultiScript.lstDwgList.AddItem tmp
''''                Loop
''''
''''                Close fh
''''            End If
''''        End If
''''    End With
''''
    Dim txtFile As String
    Dim initFolder As String
    Dim filter As String
    Dim fh As Integer
    Dim tmp As String
    
    initFolder = ThisDrawing.Path
    filter = "Text Files (*.txt)|*.txt|All Files (*.*)|*.*"
    
    txtFile = FileBrowseOpen(initFolder, "Select Text File (*.txt)", filter, 0)
    If Len(txtFile) > 0 Then
        lstDwgList.Clear
        fh = FreeFile
        Open txtFile For Input As #fh
        
        Do While Not EOF(fh)
            Line Input #fh, tmp
            frmMultiScript.lstDwgList.AddItem tmp
        Loop
        
        Close fh
    End If
    
    lstDwgList_Change
    
End Sub

HTH

[Stuboy]

Thank you so much norman, your insight and time is appreciated.'

with the common dialog it seems to have a compile error when I run it from my limited experience this is usually a reference problem? it is producing error at  the first line below (highlighted red in module);

is this because of the private declarations?

Public Const OFN_ALLOWMULTISELECT As Long = &H200
Public Const OFN_CREATEPROMPT As Long = &H2000
Public Const OFN_ENABLEHOOK As Long = &H20
Public Const OFN_ENABLETEMPLATE As Long = &H40
Public Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Public Const OFN_EXPLORER As Long = &H80000
Public Const OFN_EXTENSIONDIFFERENT As Long = &H400
Public Const OFN_FILEMUSTEXIST As Long = &H1000
Public Const OFN_HIDEREADONLY As Long = &H4
Public Const OFN_LONGNAMES As Long = &H200000
Public Const OFN_NOCHANGEDIR As Long = &H8
Public Const OFN_NODEREFERENCELINKS As Long = &H100000
Public Const OFN_NOLONGNAMES As Long = &H40000
Public Const OFN_NONETWORKBUTTON As Long = &H20000
Public Const OFN_NOREADONLYRETURN As Long = &H8000& '*see comments
Public Const OFN_NOTESTFILECREATE As Long = &H10000
Public Const OFN_NOVALIDATE As Long = &H100
Public Const OFN_OVERWRITEPROMPT As Long = &H2
Public Const OFN_PATHMUSTEXIST As Long = &H800
Public Const OFN_READONLY As Long = &H1
Public Const OFN_SHAREAWARE As Long = &H4000
Public Const OFN_SHAREFALLTHROUGH As Long = 2
Public Const OFN_SHAREWARN As Long = 0
Public Const OFN_SHARENOWARN As Long = 1
Public Const OFN_SHOWHELP As Long = &H10
Public Const OFN_ENABLESIZING As Long = &H800000
Public Const OFS_MAXPATHNAME As Long = 260

'OFS_FILE_OPEN_FLAGS:
Public Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER Or _
OFN_LONGNAMES Or _
OFN_CREATEPROMPT Or _
OFN_NODEREFERENCELINKS

I have pasted compile error as image 

Thanks a lot the class module revised code looks great.

Stu

[norman.yuan]

Did you do the "step 1" as my first reply said - comment out all code in your original class "CommonDialog" (or you simply delete that class from the VBA project?

My code (well, borrowed from the internet with minor change I made) is based on the same Windows API (ComDialog32) as yours (which has error, thus the compile error). 

HTH

[Stuboy]

Hi Norman,

i replaced all all the original code in the commondialog module with the code you supplied, so deleted original and pasted all new code in.

and replaced the three (functions) you made changes to in the form module, you had the original code in your code but it had been all remmed out ‘ 

thanks mate, 

stu 

[Stuboy]

Hey Norm,

I have attached a zip of code as it sits as stated above,

Thanks and appreciate your time

Stu

[norman.yuan]

The code I provided should be in code Module, not Class. That is, create a Module, copy all the code into it.

With your latest DVB file, what you need to do is:

1. Add a new module in the project, name it whatever you like;

2. Copy all code in class "modCommonDialog64bit" into the new modeule;

3. Delete class "modCommonDialog64bit".

Then off you go.

Surely you can convert the code into a class, if you know how class works in VBA. VBA code Module is "Shared/Static" class itself. But in this case, letting the common dialog functionality stay in VBA module would be simple/useful enough.

HTH

[Stuboy]

Thanks Norman,

My VBA is limited been several years since I mucked around with some small stuff.

I have completed what you have said by creating a new code module with code you provided in it, and deleting the class module,

I am still getting a "compile error: variable not defined" at bottom line

Public Function GetFiles( _
    ByVal sInitFolder As String, _
    ByVal sTitle As String, _
    ByVal sFilter As String, _
    ByVal nFilterIndex As Integer) As String()

do all variables must be declared before use?

Sorry to test your patience 🙂

[Stuboy]

One thing to note is all buttons now work except for the "add drawing"

Thanks a heap

[Stuboy]

Hi Norman,

Think I have it working (well sort of) I defined the strreturn as below 

Public Function GetFiles( _
    ByVal sInitFolder As String, _
    ByVal sTitle As String, _
    ByVal sFilter As String, _
    ByVal nFilterIndex As Integer) As String()
    
    Dim strReturn As String 'declared variable here
    
    strReturn = FileBrowseOpen(sInitFolder, sTitle, sFilter, nFilterIndex, True)
    GetFiles = Split(strReturn, ",")
    
End Function

Now onto new problems runtime errors 😉  I appreciate all your time mate and thank you least the code is partly working .

All the best 

SB

[Anonymous]

if you can run my vba project, it will be very helpful for me. without this file i am way less. please help me. 

[norman.yuan]

Where/what is your VBA project? 

Also, one may want to be careful to run code from unknown source. So, before you want to ask someone to run/test your code, you might as well first describe what issue do you have in detail. Appending a question to a long discussion thread without providing details would hardly get you to anywhere.

[Anonymous]

Thanks for replying quickly. I have a protected code for survey data auto
feature generator . Which i got from someone many days ago. But recently i
have updated my compute. But password is not available. So i try to
unprotected this code by hex editor. But after unprotection it's showing a
message like "this code is for 32 bit, its upgrade to 64 bit". Please help
me to run this code.

[Anonymous]

please see the attach file.

regards

salma

[Anonymous]

Hello.

I`ve tried to run this code and faced with this problem:

VBA runs an error when i try to click the button "Browse"

could you tell me where is my mistake?

[norman.yuan]

It is likely that your VBA project has missing references. Go into VBA editor, click menu "Tools->References...", and in the "References" dialog box, looking for checked item(s) that is flagged as "Missing - xxxxx". Depending on what the missing reference is, you need to resolve it.