如何用CommonDialog对话框选取多个文件

mccad

2. Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
3.     (pOpenfilename As OPENFILENAME) As Long
4. Public Const OFN_PATHMUSTEXIST = &H800
5. Public Const OFN_FILEMUSTEXIST = &H1000
6. Public Const OFN_HIDEREADONLY = &H4 '隐蔽只读复选框
7. Public Const OFN_ALLOWMULTISELECT = &H200
8. Private Const OFN_EXPLORER As Long = &H80000
9. Public Type OPENFILENAME
10.     lStructSize As Long
11.     hwndOwner As Long '拥有对话框的窗口
12.     hInstance As Long
13.     lpstrFilter As String '装载文件过滤器的缓冲区
14.     lpstrCustomFilter As String
15.     nMaxCustFilter As Long
16.     nFilterIndex As Long
17.     lpstrFile As String
18.     nMaxFile As Long
19.     lpstrFileTitle As String
20.     nMaxFileTitle As Long
21.     lpstrInitialDir As String
22.     lpstrTitle As String '对话框的标题
23.     flags As Long
24.     nFileOffset As Integer
25.     nFileExtension As Integer
26.     lpstrDefExt As String
27.     lCustData As Long
28.     lpfnHook As Long
29.     lpTemplateName As String
30. End Type
31. '选择文件函数GetFile
32. Function GetFile(strTitle As String, strFilter As String, Optional MultiSelect As Boolean = False, Optional strIniDir As String) As String
33. On Error Resume Next
34. Dim FileName As String
35. Dim OFileBox As OPENFILENAME
36. With OFileBox
37.     .lpstrTitle = strTitle '对话框标题
38.     .lpstrInitialDir = strIniDir '初始目录
39.     .lStructSize = Len(OFileBox)
40.     .hwndOwner = ThisDrawing.HWND
41.     If MultiSelect Then
42.         .flags = OFN_EXPLORER Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or OFN_ALLOWMULTISELECT
43.     Else
44.         .flags = OFN_EXPLORER Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
45.     End If
46.     .lpstrFile = String$(255, 0)
47.     .nMaxFile = 255
48.     .lpstrFileTitle = String$(255, 0)
49.     .nMaxFileTitle = 255
50.     .lpstrFilter = strFilter  '过滤器
51.     .nFilterIndex = 1
52. End With
53. lntFile = GetOpenFileName(OFileBox) '执行打开对话框
54. If lntFile <> 0 Then
55.         FileName = Left(OFileBox.lpstrFile, InStr(OFileBox.nFileOffset + 1, OFileBox.lpstrFile, _
56.                         Chr(0) & Chr(0), vbBinaryCompare))
57.     GetFile = FileName
58. Else
59.     GetFile = ""
60. End If
61. End Function
62. '示例
63. Sub gf()
64.     Dim f As String
65.     f = GetFile("明经通道 http://www.mjtd.com VBA 示例", "图形文件(*.dwg)" & vbNullChar & "*.dwg", True)
66.     Debug.Print f
67. End Sub

Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _     (pOpenfilename As OPENFILENAME) As Long Public Const OFN_PATHMUSTEXIST = &H800 Public Const OFN_FILEMUSTEXIST = &H1000 Public Const OFN_HIDEREADONLY = &H4 '隐蔽只读复选框 Public Const OFN_ALLOWMULTISELECT = &H200 Private Const OFN_EXPLORER As Long = &H80000 Public 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 '选择文件函数GetFile Function GetFile(strTitle As String, strFilter As String, Optional MultiSelect As Boolean = False, Optional strIniDir As String) As String On Error Resume Next Dim FileName As String Dim OFileBox As OPENFILENAME With OFileBox     .lpstrTitle = strTitle '对话框标题     .lpstrInitialDir = strIniDir '初始目录     .lStructSize = Len(OFileBox)     .hwndOwner = ThisDrawing.HWND     If MultiSelect Then         .flags = OFN_EXPLORER Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or OFN_ALLOWMULTISELECT     Else         .flags = OFN_EXPLORER Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY     End If     .lpstrFile = String$(255, 0)     .nMaxFile = 255     .lpstrFileTitle = String$(255, 0)     .nMaxFileTitle = 255     .lpstrFilter = strFilter  '过滤器     .nFilterIndex = 1 End With lntFile = GetOpenFileName(OFileBox) '执行打开对话框 If lntFile <> 0 Then         FileName = Left(OFileBox.lpstrFile, InStr(OFileBox.nFileOffset + 1, OFileBox.lpstrFile, _                         Chr(0) & Chr(0), vbBinaryCompare))     GetFile = FileName Else     GetFile = "" End If End Function '示例 Sub gf()     Dim f As String     f = GetFile("明经通道 http://www.mjtd.com VBA 示例", "图形文件(*.dwg)" & vbNullChar & "*.dwg", True)     Debug.Print f End Sub