VBA移动文件报错：目标文件夹存在同名文件时出错求解决方案

下面是优化后的代码，解决了同名文件报错问题，同时提供替换文件、保留源文件（跳过）、终止操作三种选择：

Sub moveAllFilesInDateFolder()
    Dim DateFold As String, fileName As String
    Dim userChoice As VbMsgBoxResult
    Const sFolderPath As String = "E:\Uploading\Source"
    Const dFolderPath As String = "E:\Uploading\Archive"
    
    ' 创建当日日期命名的目标文件夹（不存在则新建）
    DateFold = dFolderPath & "\" & Format(Date, "ddmmyyyy")
    If Dir(DateFold, vbDirectory) = "" Then MkDir DateFold
    
    ' 遍历源文件夹所有文件
    fileName = Dir(sFolderPath & "\*.*")
    Do While fileName <> ""
        ' 检查目标文件夹是否已存在同名文件
        If Dir(DateFold & "\" & fileName) <> "" Then
            ' 弹出对话框让用户选择操作
            userChoice = MsgBox("目标文件夹已存在文件：" & fileName & vbCrLf & vbCrLf & _
                              "选择操作：" & vbCrLf & _
                              "是 = 替换目标文件" & vbCrLf & _
                              "否 = 跳过该文件" & vbCrLf & _
                              "取消 = 终止全部操作", _
                              vbYesNoCancel + vbExclamation, "文件已存在")
            
            Select Case userChoice
                Case vbYes
                    ' 先删除目标文件，再移动源文件
                    Kill DateFold & "\" & fileName
                    Name sFolderPath & "\" & fileName As DateFold & "\" & fileName
                Case vbNo
                    ' 跳过当前文件，直接处理下一个
                Case vbCancel
                    ' 终止循环，退出程序
                    Exit Do
            End Select
        Else
            ' 目标文件不存在，直接移动
            Name sFolderPath & "\" & fileName As DateFold & "\" & fileName
        End If
        
        ' 获取下一个文件名
        fileName = Dir
    Loop
End Sub

关键修改说明 #

• 同名文件检测：每次处理文件前，用Dir(DateFold & "\" & fileName)判断目标路径下是否已有同名文件
• 用户交互选择：通过MsgBox弹出带选项的对话框，明确告知用户当前情况并提供操作选择
• 分支逻辑处理：
  • 选择「是」：先删除目标文件夹里的同名文件，再执行移动操作
  • 选择「否」：跳过当前文件，继续处理下一个
  • 选择「取消」：直接终止整个移动流程
• 保留原有核心功能：原有的自动创建当日日期文件夹、遍历源文件夹文件的逻辑完全保留

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