Author Topic: Can Not See Sub-Folders in Dialog Box  (Read 2047 times)

0 Members and 1 Guest are viewing this topic.

Vince

  • Newt
  • Posts: 55
Can Not See Sub-Folders in Dialog Box
« on: February 07, 2012, 10:07:04 AM »
Hi Swamp Members,

My company has migrated to 64bit Windows 7 workstations and we are running AutoCAD 2012. When I try to use some of my VBA routines, that worked perfectly on my old 32bit Windows XP computers.....The dialog box that allows me to browse to project drawing folders to select drawing files can not see some of the drawing sub-folders nor their contents of drawing files. I can not identify why I am experiencing this difficulty....??

An example of the folder names are as follows:

5515-20111005-Schematic Design Issue
5515-20110526 PreliminaryLayouts

The VBA code string I used to call the dialog box to select the drawings within the folders is as follows:

CommonDialog1.Filter = "Drawings Files (*.dwg) |*.dwg|"
     CommonDialog1.DialogTitle = "Select Drawing Files To Plot"
     CommonDialog1.MaxFileSize = 5000
     CommonDialog1.FilterIndex = 1
     CommonDialog1.InitDir = "F:\Projects\"
     CommonDialog1.flags = (FileOpenConstants.cdlOFNAllowMultiselect)
     CommonDialog1.ShowOpen
   
    If CommonDialog1.FileName <> "" Then
        lsFiles = Split(CommonDialog1.FileName)
            For i = LBound(lsFiles) To UBound(lsFiles)
                txtFile = UBound(lsFiles)
            Next i
                         
            If txtFile < 2 Then
                MsgBox "This is A Batch Plot Utility: Please Select More Than One Drawing", vbInformation, "Batch Utility"
            Else
           
                sTmpPrefix = lsFiles(1)
                sTmpPrefix = Mid(sTmpPrefix, 1, InStr(1, sTmpPrefix, "-") - 1)
               
                For i = LBound(lsFiles) To UBound(lsFiles)
                    lstDwgList.AddItem lsFiles(i)
                Next i
               
            End If
    End If


It would be appreciated if someone can take a look at the code sample above to see if they can identify what might be causing the problem.

Thank you in advance for you assistance....!


Regards, Vince

ChuckHardin

  • Guest
Re: Can Not See Sub-Folders in Dialog Box
« Reply #1 on: February 07, 2012, 03:43:53 PM »
Here is a class module I use in VBA apps. I DO NOT use the CommonDialog control.
I also do not know if this works with Windows 7 or AutoCAD 2012.

clsFileDialog
Code: [Select]
Option Explicit
'//The Win32 API Functions///
Private Declare Function GetSaveFileName Lib _
"comdlg32.dll" Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long

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

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

'//A few of the available Flags///
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_ALLOWMULTISELECT = &H200
'This one keeps your dialog from turning into
'A browse by folder dialog if multiselect is true!
'Not sure what I mean? Remove it from the flags
'In the "Show Open" & "Show Save" methods.
Private Const OFN_EXPLORER As Long = &H80000
'//The Structure
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

Private lngHwnd As Long
Private strFilter As String
Private strTitle As String
Private strDir As String
Private blnHideReadOnly As Boolean
Private blnAllowMulti As Boolean
Private blnMustExist As Boolean

Public Property Let OwnerHwnd(WindowHandle As Long)
    '//FOR YOU TODO//
    'Use the API to validate this handle
    lngHwnd = WindowHandle
    'This value is set at startup to the handle of the
    'AutoCAD Application window, if you want the owner
    'to be a user form you will need to obtain its
    'Handle by using the "FindUserForm" function in
    'This class.
End Property

Public Property Get OwnerHwnd() As Long
    OwnerHwnd = lngHwnd
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 the 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 InitialDir(strFolder As String)
    'Sets the directory the dialog displays when called
    If Len(Dir(strFolder)) > 0 Then
        strDir = strFolder
        Else
        Err.Raise 514, "FileDialog", "Invalid Initial Directory"
    End If
End Property

Public Property Let HideReadOnly(blnVal As Boolean)
    blnHideReadOnly = blnVal
End Property

Public Property Let MultiSelect(blnVal As Boolean)
    'allow users to select more than one file using
    'The Shift or CTRL keys during selection
    blnAllowMulti = blnVal
End Property

Public Property Let FileMustExist(blnVal As Boolean)
    blnMustExist = blnVal
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.lpstrFile = Space$(254)
    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 booleans to
    'set the flag
    If blnHideReadOnly And blnAllowMulti And blnMustExist Then
        udtStruct.flags = OFN_HIDEREADONLY Or _
        OFN_ALLOWMULTISELECT Or OFN_EXPLORER Or OFN_FILEMUSTEXIST
        ElseIf blnHideReadOnly And blnAllowMulti Then
        udtStruct.flags = OFN_ALLOWMULTISELECT _
        Or OFN_EXPLORER Or OFN_HIDEREADONLY
        ElseIf blnHideReadOnly And blnMustExist Then
        udtStruct.flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST
        ElseIf blnAllowMulti And blnMustExist Then
        udtStruct.flags = OFN_ALLOWMULTISELECT Or _
        OFN_EXPLORER Or OFN_FILEMUSTEXIST
        ElseIf blnHideReadOnly Then
        udtStruct.flags = OFN_HIDEREADONLY
        ElseIf blnAllowMulti Then
        udtStruct.flags = OFN_ALLOWMULTISELECT _
        Or OFN_EXPLORER
        ElseIf blnMustExist Then
        udtStruct.flags = OFN_FILEMUSTEXIST
    End If
    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)
    udtStruct.nMaxFile = 255
    udtStruct.lpstrFileTitle = Space$(254)
    udtStruct.nMaxFileTitle = 255
    'Use our private variable
    udtStruct.lpstrInitialDir = strDir
    'Use our private variable
    udtStruct.lpstrTitle = strTitle
    If blnMustExist Then
        udtStruct.flags = OFN_FILEMUSTEXIST
    End If
    If GetSaveFileName(udtStruct) Then
        strTemp = (Trim(udtStruct.lpstrFile))
        ShowSave = Mid(strTemp, 1, Len(strTemp) - 1)
    End If
End Function

In your code add:
Code: [Select]
Dim fd1 As New clsFileDialog
 
 SetFiles = False
 Set fd1 = New clsFileDialog
 fd1.FileMustExist = True
 fd1.OwnerHwnd = application.HWND
 fd1.Filter = "Drawings Files (*.dwg) |*.dwg"
 fd1.Title = "Select Drawings to Plot"
 fd1.MultiSelect = True
 fd1.InitialDir = "F:\Projects\"
 strCTRFile = fd1.ShowOpen
 'Then check for no selection and split like you are