weixin_29832331
UPDATE DEFAULT
采纳率60%
2016-01-21 05:00

vba 自动加载宏 批量打开并保存xls

10
已采纳

把下面修改成遍历当前目录,而不是子目录,还有就是如何自动加载宏
Sub test()
Dim mPath As String, fA As String, mAry(1 To 1000), k As Integer, i As Integer, wb As Workbook
On Error Resume Next
If Workbooks.Count > 1 Then
MsgBox "关闭其他工作簿!": Exit Sub
'----------设置父文件夹路径-----
mPath = "D:\Project overview 2015"
fA = Dir(mPath & "*", vbDirectory)
'开始收集子目录名称
k = 0
Do While fA <> ""
If fA <> "." And fA <> ".." Then
If (GetAttr(mPath & "\" & fA) And vbDirectory) = vbDirectory Then
k = k + 1
mAry(k) = fA
End If
End If
fA = DirLoop
'--------------遍历各子目录--------
Application.DisplayAlerts = False
For i = 1 To k
fA = Dir(mPath & "\" & mAry(i) & "*.xls*")
Do While fA <> ""
If fA <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(mPath & "\" & mAry(i) & "\" & fA, , False) '打开
wb.Save '保存
wb.Close True '关闭
End If
fA = Dir
Loop
Next i
Application.DisplayAlerts = True
MsgBox "处理完成!"
End Sub

  • 点赞
  • 写回答
  • 关注问题
  • 收藏
  • 复制链接分享
  • 邀请回答

2条回答

  • weixin_29832331 UPDATE DEFAULT 5年前

    哎,没想到还是自己解决了,查了下dir就搞定了

    点赞 评论 复制链接分享
  • Mr_dsw Andoter 5年前

    vb用的少了,无能为力啊!

    点赞 评论 复制链接分享

相关推荐