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
Solved! Go to Solution.
Solved by norman.yuan. Go to Solution.
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
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
Norman Yuan
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
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
Norman Yuan
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
Hey Norm,
I have attached a zip of code as it sits as stated above,
Thanks and appreciate your time
Stu
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
Norman Yuan
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 🙂
One thing to note is all buttons now work except for the "add drawing"
Thanks a heap
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
if you can run my vba project, it will be very helpful for me. without this file i am way less. please help me.
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.
Norman Yuan
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?
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.
Norman Yuan