请求协助实现FTP账户按日期层级自动建夹并迁移文件

核心修改说明 #

将原代码的单一日期文件夹逻辑，替换为年→月→日三级层级路径的动态生成逻辑，确保每一级文件夹不存在时自动创建，同时保留原有的文件去重移动逻辑。

修改后的VBA代码 #

Sub moveFilesToDateHierarchy()
    Dim yearFolder As String, monthFolder As String, dayFolder As String
    Dim targetPath As String, fileName As String, objFSO As Object
    Const sFolderPath As String = "E:\Uploading\Source"
    Const dFolderPath As String = "E:\Uploading\Destination" ' 此处为FTP映射的本地根目录（或FTP服务器根路径映射）

    ' 按需求生成年/月/日三级路径
    yearFolder = dFolderPath & "\" & Format(Date, "yyyy")
    monthFolder = yearFolder & "\" & Format(Date, "mm")
    dayFolder = monthFolder & "\" & Format(Date, "dd")

    ' 初始化文件系统操作对象
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    ' 逐级检查并创建文件夹：先年份，再月份，最后日期
    If Not objFSO.FolderExists(yearFolder) Then
        objFSO.CreateFolder yearFolder
    End If
    If Not objFSO.FolderExists(monthFolder) Then
        objFSO.CreateFolder monthFolder
    End If
    If Not objFSO.FolderExists(dayFolder) Then
        objFSO.CreateFolder dayFolder
    End If

    ' 遍历源文件夹内所有文件
    fileName = Dir(sFolderPath & "\*.*")
    Do While fileName <> ""
        ' 检查目标路径是否已存在该文件，避免重复移动
        If Not objFSO.FileExists(dayFolder & "\" & fileName) Then
            ' 移动文件至对应日期层级文件夹
            Name sFolderPath & "\" & fileName As dayFolder & "\" & fileName
        End If
        fileName = Dir ' 获取下一个待处理文件
    Loop

    ' 释放对象资源
    Set objFSO = Nothing
End Sub

关键细节提示 #

1. 层级创建可靠性：使用FileSystemObject的FolderExists和CreateFolder方法，避免了直接用MkDir时因上级目录不存在导致的报错，自动适配跨月、跨年的新文件夹创建需求。
2. 日期格式匹配：通过Format(Date, "yyyy")/"mm"/"dd"生成严格符合要求的四位年份、两位月份/日期格式，完美对应2023/01/01的层级结构。
3. 远程FTP适配：如果你的FTP是未映射成本地盘符的远程服务器，需在本地文件移动完成后，额外添加FTP上传逻辑（可通过Shell执行FTP命令脚本，或调用WinINet API实现）。

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