如何用VBA每周自动更新带周日日期的工作簿文件路径

核心思路 #

通过VBA自动计算当周周日的日期，动态生成工作簿文件名替代硬编码的日期值，同时优化原脚本中冗余的Select/Activate操作，提升代码稳定性和运行效率。

实现步骤与优化后代码 #

1. 自动计算目标日期：利用Date和Weekday函数获取当周周日，并格式化为MM.DD.YY格式
2. 动态拼接文件路径：用计算出的日期字符串生成工作簿完整路径
3. 简化复制逻辑：直接引用工作簿/工作表对象，避免不必要的界面操作

优化后的完整代码：

Sub AutoCopyScheduleData()
    Application.ScreenUpdating = False
    
    Dim sourceWB As Workbook
    Dim destWB As Workbook
    Dim sourceWS As Worksheet
    Dim dateStr As String
    Dim currentSunday As Date
    
    ' 计算当周周日日期（当天是周日则直接取当天，否则取本周日）
    currentSunday = Date + (7 - Weekday(Date, vbMonday))
    ' 格式化为MM.DD.YY字符串
    dateStr = Format(currentSunday, "mm.dd.yy")
    
    ' 打开源工作簿（工作簿1：SCHED MM.DD.YY.xlsm）
    Set sourceWB = Workbooks.Open(Filename:="C:\Users\jvittur\OneDrive\Desktop\Orginal Schedules\SCHED " & dateStr & ".xlsm")
    Set sourceWS = sourceWB.Sheets("ROADMAP")
    
    ' 目标工作簿为当前运行脚本的工作簿（工作簿2：Sched Pickup MM.DD.YY.xlsm）
    Set destWB = ThisWorkbook
    
    ' 直接复制指定区域到目标位置，无需Select/Activate
    sourceWS.Range("A400:AI550").Copy destWB.ActiveSheet.Range("A1")
    
    ' 关闭源工作簿（不保存修改）
    sourceWB.Close SaveChanges:=False
    
    Application.ScreenUpdating = True
End Sub

关键说明 #

• 日期计算逻辑：Weekday(Date, vbMonday)返回当前日期是本周的第几天（周一=1，周日=7），通过Date + (7 - 该值)可确保无论当天是周几，都能得到本周日的日期。
• 避免界面操作：直接引用对象的方式比Select/Activate更高效，也不会因窗口切换导致代码报错。
• 路径调整：若文件路径变动，只需修改Workbooks.Open中的路径前缀即可。

内容的提问来源于stack exchange，提问作者Rose Vittur