[已解决]请教

我心飞翔410 · 发表于 2013-6-8 14:30

在一个文件夹下很多表怎么才能实现批量打印？？

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-6-10 09:29

Sub Main()
Dim strPath As String
Dim strFilename As String
Dim iCount As Integer
Dim arrFilename(1 To 1024) As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
strPath = .SelectedItems(1)
Else
MsgBox "没有选择文件夹" & vbCrLf & "点确定后代码结束", vbCritical + vbOKOnly
Exit Sub
End If
End With
If Not Right(strPath, 1) Like "" Then strPath = strPath & Application.PathSeparator
strFilename = Dir(strPath & "*.xls")
Do While Len(strFilename) > 0 And strFilename <> ThisWorkbook.Name
Debug.Print strFilename
iCount = iCount + 1
arrFilename(iCount) = strPath & strFilename
strFilename = Dir
Loop
'所有的完全文件名都在数组arrFilename中
'另外需要注意的是，当文件夹内文件数量大于1024时，就会出错。数组固定了。
End Sub

复制代码

跳转到最佳答案楼层

无聊的疯子 · 发表于 2013-6-8 15:00

写代码，循环处理就可以实现了

要不你自己手工操作也可以实现

再不就按排别人去手工操作，这三个方法都可以

我心飞翔410 · 发表于 2013-6-9 09:22

无聊的疯子发表于 2013-6-8 15:00
写代码，循环处理就可以实现了

要不你自己手工操作也可以实现

晕无聊的回答啊
肯定用高效的办法啊

lsggjie · 发表于 2013-6-9 12:42

看是否合适？

我心飞翔410 · 发表于 2013-6-10 08:28

无聊的疯子发表于 2013-6-8 15:00
写代码，循环处理就可以实现了

要不你自己手工操作也可以实现

疯子麻烦你更我解决哈这个问题嘛我想提取某个文件夹下的excel文档可以用图片的那种选择方式，把文件名放于数组中

hwc2ycy · 发表于 2013-6-10 09:24

你这个对话框得用API才能实现。
插入一个模块，代码放在模块中。

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Const BIF_RETURNONLYFSDIRS = &H1
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function ChooseFolder(Optional strTitle As String = "请选择文件夹") As String
Dim bi As BROWSEINFO
Dim pidl As Long
Dim strPath As String * 512
Dim lResult As Long
Dim iPos As Integer
With bi
.hOwner = 0&
.pidlRoot = 0&
.lpszTitle = strTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With
pidl = SHBrowseForFolder(bi)
strPath = Space$(512)
lResult = SHGetPathFromIDList(ByVal pidl&, ByVal strPath)
If lResult Then
iPos = InStr(strPath, Chr$(0))
ChooseFolder = Left(strPath, iPos - 1)
End If
End Function
Sub Main()
Dim strPath As String
Dim strFilename As String
Dim iCount As Integer
Dim arrFilename(1 To 1024) As String
strPath = ChooseFolder()
If Len(strPath) = 0 Then
MsgBox "没有选择文件夹" & vbCrLf & "点确定后代码结束", vbCritical + vbOKOnly
Exit Sub
End If
If Not Right(strPath, 1) Like "" Then strPath = strPath & Application.PathSeparator
strFilename = Dir(strPath & "*.xls")
Do While Len(strFilename) > 0 And strFilename <> ThisWorkbook.Name
Debug.Print strFilename
iCount = iCount + 1
arrFilename(iCount) = strPath & strFilename
strFilename = Dir
Loop
'所有的完全文件名都在数组arrFilename中
End Sub

复制代码

hwc2ycy · 发表于 2013-6-10 09:29

这个最佳答案由 hwc2ycy 给出，感谢 hwc2ycy 的回答。

单击隐藏图章

Sub Main()
Dim strPath As String
Dim strFilename As String
Dim iCount As Integer
Dim arrFilename(1 To 1024) As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
strPath = .SelectedItems(1)
Else
MsgBox "没有选择文件夹" & vbCrLf & "点确定后代码结束", vbCritical + vbOKOnly
Exit Sub
End If
End With
If Not Right(strPath, 1) Like "" Then strPath = strPath & Application.PathSeparator
strFilename = Dir(strPath & "*.xls")
Do While Len(strFilename) > 0 And strFilename <> ThisWorkbook.Name
Debug.Print strFilename
iCount = iCount + 1
arrFilename(iCount) = strPath & strFilename
strFilename = Dir
Loop
'所有的完全文件名都在数组arrFilename中
'另外需要注意的是，当文件夹内文件数量大于1024时，就会出错。数组固定了。
End Sub

复制代码

hwc2ycy · 发表于 2013-6-10 09:32

还是用系统自带的好点，用API太麻烦了，除非是不得借助API才能完在的功能。

		自动登录	找回密码
密码			注册

[已解决]请教

评分