【求助】VB6的代码如何在VBA中运行(调用API多文件的选择)

薛双成

目的：在SolidWorks中调用获取多选文件的路径
SolidWorks与excel的编译环境都是VBA，所以在VBA环境中测试，“Appcalition.GetOpenFilename”在SolidWorks中使用存在bug，所以想到了调用API函数，以下代码在VB6.0中测试没有问题，但放到excel中却没有响应，不清楚问题出在哪，请大神指教，谢谢！！！
打开文件对话框.zip (17.19 KB, 下载次数: 0)

2022-11-11 10:30 上传

点击文件名下载附件

Option Explicit
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 Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private sFileName() As String
Function OpenFiles(ByVal hwnd As Long, ByVal sTitle As String, ByVal sStyle As String, ByVal uFlag As Long, Optional lMaxFileNum As Long) As String
Dim ofn As OPENFILENAME
Const OFN_ALLOWMULTISELECT = &H200
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000

If Len(Trim(Str(lMaxFileNum))) = 0 Then lMaxFileNum = 1000000
uFlag = IIf(uFlag = 1, OFN_ALLOWMULTISELECT Or OFN_EXPLORER Or OFN_FILEMUSTEXIST, OFN_EXPLORER Or OFN_FILEMUSTEXIST)
With ofn
.lStructSize = Len(ofn)
'.hwndOwner = hwnd
'.hInstance = App.hInstance
.lpstrFile = Space$(lMaxFileNum - 1)
.nMaxFile = lMaxFileNum
.lpstrFileTitle = Space$(lMaxFileNum - 1)
.nMaxFileTitle = lMaxFileNum
.lpstrTitle = sTitle
.lpstrFilter = "All Surported Files" + Chr$(0) + sStyle + Chr$(0)
.flags = uFlag
End With
Dim lRet As Long
lRet = GetOpenFileName(ofn)
OpenFiles = IIf(lRet > 0, ofn.lpstrFile, "")
End Function
Function GetFileNames(ByVal tmpString As String) As Integer
Dim FileNames() As String
FileNames() = Split(tmpString, vbNullChar)
If UBound(FileNames()) < 3 Then
ReDim sFileName(0)
sFileName(0) = FileNames(0)
GetFileNames = 0
Else
Dim m As Integer
GetFileNames = UBound(FileNames) - 3
ReDim sFileName(0 To GetFileNames)
For m = 0 To GetFileNames
sFileName(m) = IIf(Right(FileNames(0), 1) = "\", FileNames(0) + FileNames(m + 1), FileNames(0) + "\" + FileNames(m + 1))
Next
End If
End Function

Private Sub Command1_Click()
Dim tString As String
tString = OpenFiles(0, "打开", "*.*", 1, 1000000)
If tString <> "" Then
Dim iFileNum As Integer, i As Integer
iFileNum = GetFileNames(tString)
For i = 0 To iFileNum
List1.AddItem sFileName(i)
Next
End If
End Sub


excel中的代码

Option Explicit
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 Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private sFileName() As String
Function OpenFiles(ByVal hwnd As Long, ByVal sTitle As String, ByVal sStyle As String, ByVal uFlag As Long, Optional lMaxFileNum As Long) As String
Dim ofn As OPENFILENAME
Const OFN_ALLOWMULTISELECT = &H200
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
If Len(Trim(Str(lMaxFileNum))) = 0 Then lMaxFileNum = 1000000

uFlag = IIf(uFlag = 1, OFN_ALLOWMULTISELECT Or OFN_EXPLORER Or OFN_FILEMUSTEXIST, OFN_EXPLORER Or OFN_FILEMUSTEXIST)

With ofn
.lStructSize = Len(ofn)
'.hwndOwner = Application.hwnd
'.hInstance =Application..hInstance
.lpstrFile = Space$(lMaxFileNum - 1)
.nMaxFile = lMaxFileNum
.lpstrFileTitle = Space$(lMaxFileNum - 1)
.nMaxFileTitle = lMaxFileNum
.lpstrTitle = sTitle
.lpstrFilter = "All Surported Files" + Chr$(0) + sStyle + Chr$(0)
.flags = uFlag
End With

Dim lRet As Long
lRet = GetOpenFileName(ofn)
OpenFiles = IIf(lRet > 0, ofn.lpstrFile, "")

End Function

Function GetFileNames(ByVal tmpString As String) As Integer
Dim FileNames() As String
FileNames() = Split(tmpString, vbNullChar)
If UBound(FileNames()) < 3 Then
ReDim sFileName(0)
sFileName(0) = FileNames(0)
GetFileNames = 0
Else
Dim m As Integer
GetFileNames = UBound(FileNames) - 3
ReDim sFileName(0 To GetFileNames)
For m = 0 To GetFileNames
sFileName(m) = IIf(Right(FileNames(0), 1) = "\", FileNames(0) + FileNames(m + 1), FileNames(0) + "\" + FileNames(m + 1))
Next
End If
End Function

Private Sub Command1_Click()
Dim tString As String
tString = OpenFiles(0, "打开", "*.*", 1, 1000000)
If tString <> "" Then
Dim iFileNum As Integer, i As Integer
iFileNum = GetFileNames(tString)
For i = 0 To iFileNum
UserForm1.ListBox1.AddItem sFileName(i)
Next
End If
End Sub

薛双成

帖子发错地方了，烦请版主删除，谢谢！