循环浏览文件夹中的文件并添加date标签

我正在尝试去一组文件夹中的工作簿，并添加一个选项卡到每个命名的当前date。

我的代码下面打开第一个文件并正确添加Tab，但不循环打开剩余的文件。

Sub LoopThroughFolder() Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook Set Wb = ThisWorkbook MyDir = "C:\Users\u558683\Desktop\QA VBA Project\LoopTabs\" MyFile = Dir(MyDir & "*.xlsx") ChDir MyDir Do While MyFile <> "" Workbooks.Open (MyFile) TabName = Format(Date, "mmm-yyyy") 'Change the format as per your requirement On Error GoTo AddNew Sheets(TabName).Activate Exit Sub AddNew: Sheets.Add , Worksheets(Worksheets.Count) ActiveSheet.Name = TabName ActiveSheet.Previous.Range("A1:AJ4").Copy Destination:=Range("A1") ActiveSheet.Previous.Range("AL1:AN500").Copy Destination:=Range("AK1") Loop End Sub 

Answer 1

2问题：

1. 你错过了给你下一个文件名的MyFile = Dir() 。
2. 你使用了Exit Sub ，它只是在没有继续处理的情况下退出程序。

---

固定代码：

 Sub LoopThroughFolder() Dim MyFile As String, Str As String, MyDir As String Dim Tb As Workbook, wB As Workbook Set Tb = ThisWorkbook MyDir = "C:\Users\u558683\Desktop\QA VBA Project\LoopTabs\" MyFile = Dir(MyDir & "*.xlsx") Do While MyFile <> vbNullString Set wB = Workbooks.Open(MyDir & MyFile) TabName = Format(Date, "mmm-yyyy") 'Change the format as per your requirement On Error Resume Next wB.Sheets(TabName).Activate If Err.Number > 0 Then 'AddNewSheet wB.Sheets.Add , wB.Sheets(wB.Sheets.Count) ActiveSheet.Name = TabName ActiveSheet.Previous.Range("A1:AJ4").Copy Destination:=Range("A1") ActiveSheet.Previous.Range("AL1:AN500").Copy Destination:=Range("AK1") wB.Save Else End If On Error GoTo 0 wB.Close False MyFile = Dir() Loop End Sub