如何用VBA将自动生成的PDF复制到对应格式的动态周文件夹？

你现有代码里已经拿到了生成wX文件夹的周数（比如w2里的数字2），直接复用这个周数就能拼出目标路径的25X格式文件夹，具体实现步骤如下：

核心思路 #

从现有逻辑中提取周数→用周数拼接目标路径→确保目标文件夹存在→复制PDF文件

1. 提取现有周数 #

如果你的周数是从Excel所在文件夹路径（比如I:\01-05\Data\Daily\2025\w2）提取的，用这段代码直接获取：

Dim currentFolder As String
currentFolder = ThisWorkbook.Path ' 获取当前Excel所在文件夹
Dim weekNum As Integer
' 从路径末尾的"wX"中提取数字X
weekNum = Val(Right(currentFolder, Len(currentFolder) - InStrRev(currentFolder, "w")))

如果周数是通过日期计算得到的（比如DatePart("ww", Date)），直接复用你已有的weekNum变量即可。

2. 生成目标路径 #

按照I:\04-80-PUBLIC\Daily Report\年份\25XX的格式拼接路径，其中年份可以从现有路径提取或用当前年份：

' 从现有路径提取年份（对应示例中的2025）
Dim targetYear As String
targetYear = Split(currentFolder, "\")(4) 

' 拼接目标文件夹路径，用Format补0保证周数是两位（比如周2→02→2502）
Dim targetFolder As String
targetFolder = "I:\04-80-PUBLIC\Daily Report\" & targetYear & "\25" & Format(weekNum, "00")

3. 确保目标文件夹存在 #

复制前先检查目标文件夹是否存在，不存在则创建：

If Dir(targetFolder, vbDirectory) = "" Then
    MkDir targetFolder ' 创建文件夹
End If

4. 复制PDF文件 #

假设你原有代码已经把PDF保存到了savePath变量，直接用FileCopy语句完成复制：

' 这里是你原有代码里的PDF保存路径（示例）
Dim savePath As String
savePath = currentFolder & "\" & "会议记录_w" & weekNum & "_" & Format(Date, "dddd") & ".pdf"

' 复制PDF到目标文件夹，保留原文件名
FileCopy savePath, targetFolder & "\" & Mid(savePath, InStrRev(savePath, "\") + 1)

完整整合示例代码 #

把上述逻辑嵌入到你原有的按钮功能代码中：

Sub 保存PDF并自动复制()
    ' ========== 原有保存PDF的逻辑 ==========
    Dim currentFolder As String
    currentFolder = ThisWorkbook.Path
    Dim weekNum As Integer
    weekNum = Val(Right(currentFolder, Len(currentFolder) - InStrRev(currentFolder, "w")))
    
    Dim pdfFileName As String
    pdfFileName = "会议记录_w" & weekNum & "_" & Format(Date, "dddd") & ".pdf"
    Dim savePath As String
    savePath = currentFolder & "\" & pdfFileName
    
    ' 导出为PDF
    ThisWorkbook.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=savePath, _
        Quality:=xlQualityStandard
    
    ' ========== 新增复制到目标路径的逻辑 ==========
    Dim targetYear As String
    targetYear = Split(currentFolder, "\")(4)
    Dim targetFolder As String
    targetFolder = "I:\04-80-PUBLIC\Daily Report\" & targetYear & "\25" & Format(weekNum, "00")
    
    ' 创建目标文件夹（如果不存在）
    If Dir(targetFolder, vbDirectory) = "" Then
        MkDir targetFolder
    End If
    
    ' 复制PDF文件
    FileCopy savePath, targetFolder & "\" & pdfFileName
End Sub

注意事项 #

• 如果你的周数计算逻辑不是从路径提取，直接替换weekNum的赋值即可。
• Format(weekNum, "00")是为了保证周数小于10时自动补0，符合2502而非252的格式要求。
• 若目标路径的年份规则不同，自行调整targetYear的赋值方式（比如用Year(Date)获取当前年份）。

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