获取多个文件名

-KarL- · 发表于 2022-7-5 20:00:36

我正在寻找一种方法来浏览多个图形，并用VBA中的所有文件路径填充一个列表框

提前感谢

-卡尔-

CmdrDuh · 发表于 2022-7-5 20:05:56

到目前为止你有什么？这实际上有点困难，因为VBA没有内置文件对话框。但这是非常可行的

-KarL- · 发表于 2022-7-5 20:11:17

现在，我使用了一个引用Excel文件打开对话框的函数。它在大多数情况下都能工作，但最近由于我们正在将一些计算机升级到office 2007，所以我希望尽可能去掉excel参考。


   Set ExcelApp = GetObject(, "Excel.Application")
   If Err <> 0 Then
       Err.Clear
       Set ExcelApp = CreateObject("Excel.Application")
       If Err <> o Then
           MsgBox "Could not start Excel!", vbExclamation
           End
       End If
   End If
   ExcelApp.Visible = True
   Set wbkobj = ExcelApp.Workbooks.Add
   Set shtObj = wbkobj.Worksheets(1)
   BrowseDialogMulti = excel.Application.GetOpenFilename(FileFilter:=(FileType & " (*" & Extension & "),*" & Extension & ", All Files (*.*),*.*"), Title:=Title, MultiSelect:=True)
   ExcelApp.Quit

CmdrDuh · 发表于 2022-7-5 20:13:07

我还没有玩过office 07，所以我不确定它将如何工作。显然，他们（微软）已经改变了你访问那个盒子的方式

ML0940 · 发表于 2022-7-5 20:16:43

我经常连接到这个windows浏览框，因为它很小，很容易提示用户输入一个类似块的文件。

copy


Dim objDialog As Variant, intResult As Variant, 
Dim strFilePath As String
  
Set objDialog = CreateObject("UserAccounts.CommonDialog")
    
'Use The Common Dialog, show open method to get the profile
objDialog.Filter = "Select block (*.DWG)|*.dwg"
objDialog.FilterIndex = 1
objDialog.InitialDir = "C:"
intResult = objDialog.ShowOpen
If intResult = 0 Then
 Exit Sub
Else
'Get the full path and filename
 strFilePath = objDialog.FileName
End If
Msgbox  strFilePath
End Sub

但是，据我所知，它不支持多文件选择。

有许多其他CAD人员使用的常见打开文件对话框代码；由于它使用了大量的代码，我只在需要诸如multi-select等高级功能的情况下使用它。
下面是该代码的示例
祝你好运
毫升

copy


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
Sub Test()
Dim Filter As String
Dim InitialDir As String
Dim DialogTitle As String
Dim OutputStr As String
Filter = "Drawing Files (*.dwg)" + Chr$(0) + "*.dwg" + Chr$(0) + _
"All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
InitialDir = "C:\Documents and Settings\%username%\Desktop"
DialogTitle = "Open a DWG file"
OutputStr = ShowOpen(Filter, InitialDir, DialogTitle)
MsgBox OutputStr
End Sub
Public Function ShowOpen(Filter As String, _
InitialDir As String, DialogTitle As String) As String
Dim OFName As OPENFILENAME
'Set the structure size
OFName.lStructSize = Len(OFName)
'Set the owner window
OFName.hwndOwner = 0
'Set the filter
OFName.lpstrFilter = Filter
'Set the maximum number of chars
OFName.nMaxFile = 255
'Create a buffer
OFName.lpstrFile = Space(254)
'Create a buffer
OFName.lpstrFileTitle = Space$(254)
'Set the maximum number of chars
OFName.nMaxFileTitle = 255
'Set the initial directory
OFName.lpstrInitialDir = InitialDir
'Set the dialog title
OFName.lpstrTitle = DialogTitle
'no extra flags
OFName.flags = 0
'Show the 'Open File' dialog
If GetOpenFileName(OFName) Then
ShowOpen = Trim(OFName.lpstrFile)
Else
ShowOpen = ""
End If
End Function

ML0940 · 发表于 2022-7-5 20:19:40

命令

在Office 2007中，它现在被称为Ribbon。
虽然这需要一些时间来适应，但有很多新的和先进的功能，我真的很喜欢。

如果你像我一样是一个Excel迷，那么这将是一个真正的帮助。

这是非常好的参考2003年看到什么你需要在2007年

http://office.microsoft.com/assistance/asstvid.aspx?assetid=XT101493291033&vwidth=1044&vheight=788&type=flash&CTT=11&Origin=HA101491511033

毫升

-KarL- · 发表于 2022-7-5 20:24:52

我得到了代码，但它仍然只允许我选择一个绘图。我需要更改什么才能获得多个图形？

rocheey · 发表于 2022-7-5 20:29:16

我没有带我的souce（我在工作），但本质上你必须更改OPENFILENAME UDT中的FLAGS变量。这是一个有点和'的位，像很多事情API，没有多少人记住它，只有瘟疫它。

此外，一旦开始返回多个文件名，就必须从返回的多个空字符串中解析出各个文件名，并将其打包回变体。返回字符串的第一部分将仅为路径，然后是ascii零，然后仅后跟每个单独的文件名，而不包括路径，每个文件名后跟另一个ascii零。分割函数在这里工作得很好；但是您必须记住将路径添加回每个文件名的前面。

令人困惑可能地虽然学习起来很有趣，但复制粘贴模块非常方便。。。。

rocheey · 发表于 2022-7-5 20:32:21

嗯，我在网上找到了一些信息来源，并很快修复了它，我向我所困扰的任何人道歉；但无论如何，它在这里。

该代码将打开多种类型的文件，并一次打开多个文件；您可能会看到，文件打开允许选择两者。图纸和。DXF在同一对话框窗口中。

是的，如果从根驱动器打开多个文件，则返回带有双反斜杠“\\”的文件名的代码与此不一致；
但我正在吃午饭，并没有时间来修复它，而且它无论如何都能工作，即使有两个反斜杠。所以起诉我。。。

'--------snip---snip-------------

公共类型OPENFILENAME
L结构尺寸与长度相同
hwndOwner尽可能长
hInstance尽可能长
lpstrFilter作为字符串
lpstrCustomFilter作为字符串
NMaxustFilter尽可能长
nFilterIndex尽可能长
lpstrFile作为字符串
nMaxFile尽可能长
lpstrFileTitle作为字符串
NMAXileTitle尽可能长
lpstrInitialDir作为字符串
lpstrTitle作为字符串
标志长度
nFileOffset为整数
nFileExtension为整数
lpstrDefExt作为字符串
lCustData尽可能长
尽可能长
lpTemplateName作为字符串
末端类型
公共声明函数GetOpenFileName Lib“comdlg32.dll”别名_
“GetOpenFileNameA”（pOpenFileName作为OPENFILENAME）尽可能长
n\u ALLOWMULTISELECT的公共常量=&H200&
N_EXPLORER的公共常量=&H80000
n\u文件的公共常量mustexist=&H1000&
n_hidereadoly的公共常数=&H4&
n\u路径的公共常量必须存在=&H800&

子选择多个文件（）
将文件列表设置为新集合
Dim I等长
将S变暗为字符串
ShowFileOpenDialog文件列表
带文件列表
如果然后计数>0
S=“选择了以下文件：“+vbCrLf”
对于I=1到。计数
S=S+。项目（I）+vbCrLf
下一个
MsgBox S
其他的
MsgBox“未选择任何文件！”
如果结束
以结束
末端接头

子ShowFileOpenDialog（ByRef文件列表作为集合）
将OpenFile设置为OPENFILENAME
变暗返回长度
Dim FileDir作为字符串
Dim FilePos尽可能长
Dim PrevFilePos尽可能长
使用OpenFile
.lStructSize=Len（OpenFile）
.hwndOwner=0
.H站姿=0
.lpstrFilter=“AutoCad图形”+Chr（0）+“*.dwg；*.dxf；”+_
Chr（0）+“所有文件（*.*）”+Chr（0）+“*.*”+Chr（0）+Chr（0）
.nFilterIndex=1
.lpstrFile=字符串（4096，0）
.nMaxFile=Len（.lpstrFile）-1
.lpstrFileTitle=。lpstrFile文件
.nMaxFileTitle=。nMaxFile
.lpstrInitialDir=“C:\”
.lpstrTitle=“多选图形”
.标志=OFN\u Hidereadoly+_
OFN\u路径必须存在+_
OFN\u文件必须存在+_
OFN\u ALLOWMULTISELECT+_
OFN\u浏览器
lReturn=GetOpenFileName（OpenFile）
如果返回0，则
FilePos=InStr（1.lpstrFile，Chr（0））
如果Mid（.lpstrFile，FilePos+1，1）=Chr（0），则
文件列表。添加lpstrFile文件
其他的
FileDir=Mid（.lpstrFile，1，FilePos-1）
当为True时执行
PrevFilePos=FilePos
FilePos=InStr（PrevFilePos+1，.lpstrFile，Chr（0））
如果FilePos-PrevFilePos>1，则
文件列表。添加FileDir+“\”+_
Mid（.lpstrFile，PrevFilePos+1_
FilePos-PrevFilePos-1）
其他的
退出Do
如果结束
环
如果结束
如果结束
以结束
末端接头

'--------snip--------snip--------

-KarL- · 发表于 2022-7-5 20:37:08

亲爱的，这就是我需要的！

谢谢大家的帮助。

-卡尔-

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

发表回复

精选推荐