[编程交流] 获取多个文件名

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenFileName As OPENFILENAME) As Long
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 Const OFN_ALLOWMULTISELECT = &H200&
Private Const OFN_EXPLORER = &H80000
Private Const OFN_FILEMUSTEXIST = &H1000&
Private Const OFN_HIDEREADONLY = &H4&
Private Const OFN_PATHMUSTEXIST = &H800&
Sub SelectManyFiles()
Dim FileList As New Collection
Dim I As Long
Dim S As String
ShowFileOpenDialog FileList
With FileList
If .Count > 0 Then
S = "The following files were selected:" + vbCrLf
For I = 1 To .Count
S = S + .Item(I) + vbCrLf
Next
MsgBox S
Else
MsgBox "No files were selected!"
End If
End With
End Sub
Sub ShowFileOpenDialog(ByRef FileList As Collection)
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim FileDir As String
Dim FilePos As Long
Dim PrevFilePos As Long
With OpenFile
.lStructSize = Len(OpenFile)
.hwndOwner = 0
.hInstance = 0
.lpstrFilter = "AutoCad Drawings" + Chr(0) + "*.dwg;*.dxf;" + _
Chr(0) + "All Files (*.*)" + Chr(0) + "*.*" + Chr(0) + Chr(0)
.nFilterIndex = 1
.lpstrFile = String(4096, 0)
.nMaxFile = Len(.lpstrFile) - 1
.lpstrFileTitle = .lpstrFile
.nMaxFileTitle = .nMaxFile
.lpstrInitialDir = "C:"
.lpstrTitle = "Multi Select Drawings"
.flags = OFN_HIDEREADONLY + _
OFN_PATHMUSTEXIST + _
OFN_FILEMUSTEXIST + _
OFN_ALLOWMULTISELECT + _
OFN_EXPLORER
lReturn = GetOpenFileName(OpenFile)
If lReturn <> 0 Then
FilePos = InStr(1, .lpstrFile, Chr(0))
If Mid(.lpstrFile, FilePos + 1, 1) = Chr(0) Then
FileList.Add .lpstrFile
Else
FileDir = Mid(.lpstrFile, 1, FilePos - 1)
Do While True
PrevFilePos = FilePos
FilePos = InStr(PrevFilePos + 1, .lpstrFile, Chr(0))
If FilePos - PrevFilePos > 1 Then
FileList.Add FileDir + "" + _
Mid(.lpstrFile, PrevFilePos + 1, _
FilePos - PrevFilePos - 1)
Else
Exit Do
End If
Loop
End If
End If
End With
End Sub

Do While Len(Drawing) > 0
          Tekopen = Input_Dir & "" & Drawing
          AutoCAD.Documents.Open (Tekopen)
          AutoCAD.ActiveDocument.Close
          Drawing = Dir()
Loop