Vince 发表于 2012-2-7 10:07:04

在对话框中看不到子文件夹

大家好,我的公司已经迁移到64位Windows 7工作站,我们正在运行AutoCAD 2012。当我尝试使用一些VBA例程时,这些例程在我的旧32位Windows XP计算机上运行得非常好……允许我浏览到项目图形文件夹以选择图形文件的对话框无法看到一些图形子文件夹或其图形文件的内容。我无法确定我为什么会遇到这种困难
文件夹名称的示例如下:5515-20111005-Schematic Design Issue55-20110526 PreliminaryLayoutsCommonDialog1.Filter="图形文件(*.dwg)|*。图纸|“
&nbsp CommonDialog1.DialogTitle="选择要打印的图形文件
&nbsp CommonDialog1.MaxFileSize=5000&nbsp CommonDialog1.FilterIndex=1&nbsp CommonDialog1.InitDir="F: \项目\“
&nbsp CommonDialog1.flags=(FileOpenConstants.cdlOFNAllowMultiselect)&nbsp CommonDialog1.ShowOpen&nbsp
 如果CommonDialog1.FileName&lt&燃气轮机&引用&引用;然后&nbsp&nbsp lsFiles=Split(CommonDialog1.FileName)&nbsp&nbsp&nbsp&nbsp 对于i=LBound(lsFiles)到UBound(lsFiles)&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp txtFile=UBound(lsFiles)
&nbsp&nbsp&nbsp&nbsp 下一步&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp
&nbsp&nbsp&nbsp&nbsp 如果txtFile<2然后&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp MsgBox“;这是一个Batch Plot实用程序:请选择多个图形;,“vbInformation”;批处理实用程序“
&nbsp&nbsp&nbsp&nbsp 其他&nbsp&nbsp&nbsp&nbsp&nbsp
&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp stmprefix=lsFiles(1)&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp STMPREFIX=Mid(STMPREFEX,1,InStr(1,STMPREfix,“-”)-1) &nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp
&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp 对于i=LBound(lsFiles)到UBound(lsFiles)&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp lstDwgList。添加项lsFiles(i)&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp 下一步&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp
&nbsp&nbsp&nbsp&nbsp 如果结束 如果有人能看一下上面的代码示例,看看他们是否能确定可能导致问题的原因,我们将不胜感激
提前感谢您的帮助
问候你,文斯

大天狼星 发表于 2012-2-7 15:43:53

这是我在VBA应用程序中使用的一个类模块。我不使用CommonDialog控件
我也不知道这是否适用于Windows 7或AutoCAD 2012Option 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

在代码中添加:
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
页: [1]
查看完整版本: 在对话框中看不到子文件夹