使用VBA将PDF文件移动至其他文件夹遇f.Move函数故障求助

针对你代码里f.Move无法正常工作的问题，整理几个核心问题和修复方案：

1. 目标路径格式错误 #

File.Move方法要求传入完整的目标文件路径（包含文件名），如果你的EfilePath只是文件夹路径，直接调用会报错。需要确保路径末尾带反斜杠，或者主动拼接文件名：

' 处理目标路径末尾的反斜杠
If Right(EfilePath, 1) <> "\" Then EfilePath = EfilePath & "\"
' 拼接文件名后执行移动
f.Move EfilePath & f.Name

2. 循环逻辑冲突 #

原代码同时混用了For Each f In Fldr（FileSystemObject遍历）和Dir函数，这会干扰文件遍历逻辑，导致部分文件处理异常。直接删除Dir相关的冗余代码：

' 删掉这段无用的Dir代码
'myFile = Dir(myPath & myExtension)
'If Len(Dir$(myPath & myFile)) > 0 Then
'     SetAttr (myPath & myFile), vbNormal
'End If

3. 字符串替换逻辑错误 #

原代码中替换空格时用了Replace(I, " ", "", 1, 3, vbBinaryCompare)，这里的I是单元格对象而非单元格值，且只替换前3个空格，可能导致文件名匹配失败。修正为：

Ii = I.Value
Ii = Replace(Ii, " ", "", 1, -1, vbBinaryCompare) ' 替换所有空格，确保匹配准确

4. 文件权限与占用问题 #

• 确保要移动的PDF文件没有被其他程序打开（比如Adobe Reader）
• 检查目标文件夹是否有写入权限，必要时添加错误捕获避免宏崩溃：

On Error Resume Next
f.Move EfilePath & f.Name
If Err.Number <> 0 Then
    Debug.Print "移动文件失败：" & f.Name & "，错误信息：" & Err.Description
    Err.Clear
End If
On Error GoTo 0

修正后的完整代码 #

Dim origWB As Workbook
Set origWB = ActiveWorkbook

Dim myPath As String
Dim myExtension As String

' 优化宏运行速度
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

myPath = "L:\TEST FOLDER"
If myPath = "" Then GoTo ResetSettings

myExtension = "*.pdf"

Dim NumrowsManual45DaysRM As Integer
Dim TrackingNumberRange As Range
Dim I
Dim Ii As String
Dim EfilePath As String

NumrowsManual45DaysRM = Sheets("Manual45days").Range("H2").End(xlDown).Row
Set TrackingNumberRange = Sheets("Manual45days").Range("H2:H" & NumrowsManual45DaysRM)

Dim fso As Object
Dim Fldr As Object
Dim f As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set Fldr = fso.getfolder(myPath).Files

' 遍历文件夹中的所有PDF文件
For Each f In Fldr
    ' 只处理PDF格式文件
    If LCase(fso.GetExtensionName(f.Name)) = "pdf" Then
        Debug.Print f.Name
        For Each I In TrackingNumberRange.Cells
            Ii = I.Value
            Ii = Replace(Ii, " ", "", 1, -1, vbBinaryCompare) ' 替换所有空格
            If f.Name = Ii & ".pdf" Then
                Sheets("Manual45Days").Range("A" & I.Row) = "Signature Received"
                EfilePath = Sheets("Manual45Days").Range("T" & I.Row).Value
                EfilePath = Replace(EfilePath, "  ", " ")
                
                ' 确保目标路径格式正确
                If Right(EfilePath, 1) <> "\" Then EfilePath = EfilePath & "\"
                
                ' 移动文件并捕获错误
                On Error Resume Next
                f.Move EfilePath & f.Name
                If Err.Number <> 0 Then
                    Debug.Print "移动失败：" & f.Name & "，错误：" & Err.Description
                    Err.Clear
                Else
                    Debug.Print "已移动：" & f.Name & " 到 " & EfilePath
                End If
                On Error GoTo 0
                
                Debug.Print I.Row
                Exit For ' 找到匹配项后退出内层循环，避免重复处理
            End If
        Next I
    End If
Next f

MsgBox "Task Complete!"

ResetSettings:
' 恢复系统默认设置
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True

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