ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 269|回复: 1

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

[复制链接]

TA的精华主题

TA的得分主题

发表于 2022-11-11 10:31 | 显示全部楼层 |阅读模式
本帖最后由 薛双成 于 2022-11-11 10:35 编辑

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





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



TA的精华主题

TA的得分主题

 楼主| 发表于 2022-11-11 11:20 | 显示全部楼层
帖子发错地方了,烦请版主删除,谢谢!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-12-23 19:03 , Processed in 0.040482 second(s), 12 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表