See the top rated post in this thread. Click here

Results 1 to 5 of 5

Thread: VBA/Autocad/Office 64 bit - Open File dialog box using comdlg32.dll

  1. #1
    Member
    Join Date
    2013-02
    Posts
    13
    Login to Give a bone
    0

    Default VBA/Autocad/Office 64 bit - Open File dialog box using comdlg32.dll

    The code below was obtained from :http://forums.autodesk.com/t5/Visual...1726554/page/2 and was working fine with my home PC running 32 bit Excel and ACAD 2013 on a Windows 7 64 bit PC.

    At work on a 64 bit Win 7 box with a 64 bit Office install, the file dialog boxes never display and the file is saved as drawing1.dwg. I have attempted to add the PtrSafe and LongPtr where applicable, but I'm way outside of my current skill set comfort zone...so I'm looking for some advice and wisdom.

    The code below is stored in a Class Module named FileDialogs

    Code:
    '================================================================
    ' Source for using VBA with 64 bit and 32 bit office installs
    ' http://blog.nkadesign.com/2013/vba-for-32-and-64-bit-systems/
    '
    '================================================================
    Option Explicit
    
    
    'Notice: Don't forget to set the OwnerHwnd property to the
    'handle of the calling window in order to bind the dialog
    'to the calling window.
    
    
    '//The Win32 API Functions///
    
    
    #If VBA7 Then
        Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
                "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
        
        Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
        (pOpenfilename As OPENFILENAME) As Boolean
        
        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
    
    
    #Else
        Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
                "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
        
        Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
        (pOpenfilename As OPENFILENAME) As Boolean
       
        Private Type OPENFILENAME
            lStructSize As Long
            hWndOwner As Long
            hInstance As Long
            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 Long
            lpTemplateName As String
        End Type
                       
    #End If
    (code continued in next post)

  2. #2
    Member
    Join Date
    2013-02
    Posts
    13
    Login to Give a bone
    0

    Default Re: VBA/Autocad/Office 64 bit - Open File dialog box using comdlg32.dll

    Code:
    '//Available Flags///
    Private Const OFN_ALLOWMULTISELECT = &H200
    Private Const OFN_CREATEPROMPT = &H2000
    Private Const OFN_ENABLEHOOK = &H20
    Private Const OFN_ENABLETEMPLATE = &H40
    Private Const OFN_ENABLETEMPLATEHANDLE = &H80
    Private Const OFN_EXPLORER = &H80000                         '  new look commdlg
    Private Const OFN_EXTENSIONDIFFERENT = &H400
    Private Const OFN_FILEMUSTEXIST = &H1000
    Private Const OFN_HIDEREADONLY = &H4
    Private Const OFN_LONGNAMES = &H200000                       '  force long names for 3.x modules
    Private Const OFN_NOCHANGEDIR = &H8
    Private Const OFN_NODEREFERENCELINKS = &H100000
    Private Const OFN_NOLONGNAMES = &H40000                      '  force no long names for 4.x modules
    Private Const OFN_NONETWORKBUTTON = &H20000
    Private Const OFN_NOREADONLYRETURN = &H8000
    Private Const OFN_NOTESTFILECREATE = &H10000
    Private Const OFN_NOVALIDATE = &H100
    Private Const OFN_OVERWRITEPROMPT = &H2
    Private Const OFN_PATHMUSTEXIST = &H800
    Private Const OFN_READONLY = &H1
    Private Const OFN_SHAREAWARE = &H4000
    Private Const OFN_SHAREFALLTHROUGH = 2
    Private Const OFN_SHARENOWARN = 1
    Private Const OFN_SHAREWARN = 0
    Private Const OFN_SHOWHELP = &H10
    
    'private class variables
    
    #If VBA7 Then
    Private lngHwnd As LongPtr
    #Else
    Private lngHwnd As Long
    #End If
    
    Private strFilter As String
    Private strTitle As String
    Private strDir As String
    Private strFile As String   'elj
    Private lngSelectedFilter As Long
    Private blnHideReadOnly As Boolean
    Private blnMode As Boolean
    
    Private Sub Class_Initialize()
      'Set default values when
      'class is first created
      strDir = CurDir
      strTitle = "Llamas Rule"
      strFile = ""
      strFilter = "All Files" _
      & Chr$(0) & "*.*" & Chr$(0)
      lngSelectedFilter = 0
      lngHwnd = &O0 'Desktop
    End Sub
    
    #If VBA7 Then
    Public Property Let OwnerHwnd(WindowHandle As LongPtr)
      lngHwnd = WindowHandle
    End Property
    #Else
    Public Property Let OwnerHwnd(WindowHandle As Long)
      '//FOR YOU TODO//
      'Use the API to validate this handle
      lngHwnd = WindowHandle
      'R14 users who just want to use this code:
      'Simple, don't set this property! the default
      'of &0 will work fine for most of your needs
    End Property
    #End If
    
    #If VBA7 Then
    Public Property Get OwnerHwnd() As LongPtr
      OwnerHwnd = lngHwnd
    End Property
    #Else
    Public Property Get OwnerHwnd() As Long
      OwnerHwnd = lngHwnd
    End Property
    #End If
    'elj added property
    Public Property Let MultiSelect(mode As Boolean)
        blnMode = mode
    End Property
    
    
    'elj added property
    Public Property Get MultiSelect() As Boolean
      MultiSelect = blnMode
    End Property
    Public Property Get SelectedFilter() As Long
      SelectedFilter = lngSelectedFilter
    End Property
    
    
    Public Property Let SelectedFilter(FilterNumber As Long)
      lngSelectedFilter = FilterNumber
    End Property
    
    'elj added property
    Public Property Let StartFile(FileName As String)
      'don't allow null strings
      If Not FileName = vbNullString Then
        strFile = FileName
      End If
    End Property
    
    'elj added property
    Public Property Get StartFile() As String
      StartFile = strFile
    End Property
    
    Public Property Let StartInDir(StartDir As String)
      'don't allow null strings
      If Not StartDir = vbNullString Then
        strDir = StartDir
      End If
    End Property
    
    Public Property Get StartInDir() As String
      StartInDir = strDir
    End Property
    
    Public Property Let Title(Caption As String)
      'don't allow null strings
      If Not Caption = vbNullString Then
        strTitle = Caption
      End If
    End Property
    
    Public Property Get Title() As String
      Title = strTitle
    End Property
    
    Public Property Let Filter(ByVal FilterString As String)
      'Filters change the type of files that are
      'displayed in the dialog. I have designed this
      'validation to use the same filter format the
      'Common dialog OCX uses:
      '"All Files (*.*)|*.*"
      Dim intPos As Integer
      Do While InStr(FilterString, "|") > 0
        intPos = InStr(FilterString, "|")
        If intPos > 0 Then
          FilterString = Left$(FilterString, intPos - 1) _
          & Chr$(0) & Right$(FilterString, _
          Len(FilterString) - intPos)
        End If
      Loop
      If Right$(FilterString, 2) <> Chr$(0) & Chr$(0) Then
        FilterString = FilterString & Chr$(0)
      End If
      strFilter = FilterString
    End Property
    
    
    Public Property Get Filter() As String
      'Here we reverse the process and return
      'the Filter in the same format that it was
      'entered
      Dim intPos As Integer
      Dim strTemp As String
      strTemp = strFilter
      Do While InStr(strTemp, Chr$(0)) > 0
        intPos = InStr(strTemp, Chr$(0))
        If intPos > 0 Then
          strTemp = Left$(strTemp, intPos - 1) _
          & "|" & Right$(strTemp, _
          Len(strTemp) - intPos)
        End If
      Loop
      If Right$(strTemp, 1) = "|" Then
        strTemp = Left$(strTemp, Len(strTemp) - 1)
      End If
      Filter = strTemp
    End Property
    
    Public Property Let HideReadOnly(blnVal As Boolean)
      'Simple one
      blnHideReadOnly = blnVal
    End Property
    
    Public Property Get HideReadOnly() As Boolean
      HideReadOnly = blnHideReadOnly
    End Property
    
    '@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
    ' Display and use the File open dialog
    '@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
    Public Function ShowOpen() As String
      Dim strTemp As String
      Dim udtStruct As OPENFILENAME
      udtStruct.lStructSize = Len(udtStruct)
      'Use our private variable
      udtStruct.hWndOwner = lngHwnd
      'Use our private variable
      udtStruct.lpstrFilter = strFilter
      udtStruct.nFilterIndex = lngSelectedFilter
      'elj start
    '  udtStruct.lpstrFile = Space$(254)    elj comment out
      If Not strFile = vbNullString Then
        udtStruct.lpstrFile = strFile & Space(254 - Len(strFile))
      Else
        udtStruct.lpstrFile = Space$(254)
      End If
      'elj end
      udtStruct.nMaxFile = 255
      udtStruct.lpstrFileTitle = Space$(254)
      udtStruct.nMaxFileTitle = 255
      'Use our private variable
      udtStruct.lpstrInitialDir = strDir
      'Use our private variable
      udtStruct.lpstrTitle = strTitle
      'Ok, here we test our boolean to
      'set the flags
      udtStruct.flags = 0
      If blnHideReadOnly Then udtStruct.flags = OFN_HIDEREADONLY + udtStruct.flags
      If blnMode Then udtStruct.flags = OFN_ALLOWMULTISELECT + udtStruct.flags
      If GetOpenFileName(udtStruct) Then
        strTemp = (Trim(udtStruct.lpstrFile))
        ShowOpen = Mid(strTemp, 1, Len(strTemp) - 1)
      End If
    End Function
    
    '@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
    ' Display and use the File Save dialog
    '@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@
    Public Function ShowSave() As String
        Dim strTemp As String
      Dim udtStruct As OPENFILENAME
      udtStruct.lStructSize = Len(udtStruct)
      'Use our private variable
      udtStruct.hWndOwner = lngHwnd
      'Use our private variable
      udtStruct.lpstrFilter = strFilter
    '  udtStruct.lpstrFile = Space$(254)    'elj comment out
      'elj start
      If Not strFile = vbNullString Then
        udtStruct.lpstrFile = strFile & Space(254 - Len(strFile))
      Else
        udtStruct.lpstrFile = Space$(254)
      End If
      'elj end
      udtStruct.nMaxFile = 255
      udtStruct.lpstrFileTitle = Space$(254)
      udtStruct.nMaxFileTitle = 255
      'Use our private variable
      udtStruct.lpstrInitialDir = strDir
      'Use our private variable
      udtStruct.lpstrTitle = strTitle
      'Ok, here we test our flag
      If blnHideReadOnly Then
        udtStruct.flags = OFN_HIDEREADONLY
      Else
        udtStruct.flags = 0
      End If
      If GetSaveFileName(udtStruct) Then
        strTemp = (Trim(udtStruct.lpstrFile))
        ShowSave = Mid(strTemp, 1, Len(strTemp) - 1)
      End If
    End Function

  3. #3
    Member
    Join Date
    2013-02
    Posts
    13
    Login to Give a bone
    1

    Default Re: VBA/Autocad/Office 64 bit - Open File dialog box using comdlg32.dll

    In case anyone is reading this sometime in the near future.

    Found a solution on the AutoDesk Inventor forum.

    http://forums.autodesk.com/t5/Invent...4365989#M45667

    Seems to be working on my Office 64 bit install - will have to try it at home with a 32 bit installation.

    M.

  4. #4
    Administrator Ed Jobe's Avatar
    Join Date
    2000-11
    Location
    Turlock, CA
    Posts
    6,397
    Login to Give a bone
    0

    Default Re: VBA/Autocad/Office 64 bit - Open File dialog box using comdlg32.dll

    Thanks for sharing the solution.
    C:> ED WORKING....

  5. #5
    Member
    Join Date
    2013-02
    Posts
    13
    Login to Give a bone
    0

    Default Re: VBA/Autocad/Office 64 bit - Open File dialog box using comdlg32.dll

    It worked at home on the 32bit Excel 2010 and at work on the 64 bit Excel 2010 install. Using a combination of Ed's solution from the Autodesk forum and the solution from the Inventor forum posted above.

    Thank you again Mr. Jobe for sharing the original solution in the Autodesk forum.

    M.

Similar Threads

  1. Replies: 3
    Last Post: 2012-06-17, 09:42 PM
  2. Replies: 8
    Last Post: 2007-03-28, 11:32 AM
  3. Open file dialog box does not open
    By johannvonspiralspine in forum AutoCAD General
    Replies: 5
    Last Post: 2006-02-07, 04:28 PM
  4. Lost File/Open File/Save Dialog Box on Autocad 2000i
    By thegoffs.89856 in forum AutoCAD General
    Replies: 3
    Last Post: 2005-06-30, 09:05 PM
  5. open file dialog box slow to open
    By klanier in forum AutoCAD General
    Replies: 2
    Last Post: 2004-09-09, 02:51 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •