VBA-文件搜索和复制的循环结构存在问题

我正试图在我的一个电子表格上开发一个宏，从第3行开始，以B列（例如2502-13892-33）的值为准，搜索a列中列出的源文件夹中的该文件（在B列中的值之前和之后使用通配符。一旦找到该文件，它需要使用FileCopy将该文件复制到C列中列出的目标文件夹中，但只有在以“E列”原始文件名（例如A252_2502-13892-33）的形式重命名该文件后才能使用

我想我已经找到了使这项工作正常的代码，因为当我测试它时，它的功能与我预期的完全一样，找到了文件，将它复制到新的目标，并在文件名中添加了E列的前缀和下划线。问题是，它只是在第一个文件之后停止，这让我相信有些地方出了问题与我的循环结构

我的代码如下：

    Sub MoveFiles()
Dim SourcePath As String
Dim DestPath As String
Dim PartNum As String
Dim PLISN As String
Dim LastRow As Long
Dim i As Long
Dim filename As String

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For i = 3 To LastRow
    PLISN = Cells(i, "E").Value
    PartNum = Cells(i, "B").Value

    If Right(Cells(i, "A").Value, 1) <> Application.PathSeparator Then
        SourcePath = Cells(i, "A").Value & Application.PathSeparator
    Else
        SourcePath = Cells(i, "A").Value
    End If

    If Right(Cells(i, "C").Value, 1) <> Application.PathSeparator Then
        DestPath = Cells(i, "C").Value & Application.PathSeparator
    Else
        DestPath = Cells(i, "C").Value
    End If

    If Dir$(SourcePath & "*" & PartNum & "*") = "" Then
        Cells(i, "D").Value = "Source file does not exist."
    ElseIf Dir$(DestPath & PLISN & "_" & "*" & PartNum & ".pdf") <> "" Then
        Cells(i, "D").Value = "File already exists."
    Else
        filename = Dir$(SourcePath & "*" & PartNum & "*" & ".pdf")
        'Copy the file
        FileCopy SourcePath & filename, DestPath & PLISN & "_" & filename
        Cells(i, "D").Value = "File Copied to new location"
    End If



Next i
     End Sub

    Option Explicit
Public SourcePath As String
Public DestPath As String
Dim PartNum As String
Dim PLISN As String



    Sub MoveFiles()

Dim LastRow As Long
Dim i As Long
Dim filename As String

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For i = 3 To LastRow
    PLISN = Cells(i, "B").Value
    PartNum = Cells(i, "A").Value

    If Right(SourcePath, 1) <> Application.PathSeparator Then
        SourcePath = SourcePath & Application.PathSeparator
    Else
        SourcePath = SourcePath
    End If

    If Right(DestPath, 1) <> Application.PathSeparator Then
        DestPath = DestPath & Application.PathSeparator
    Else
        DestPath = DestPath
    End If

    If Dir$(SourcePath & "*" & "*" & PartNum & "*") = "" Then
        Cells(i, "C").Value = "Source file does not exist."
    ElseIf Dir$(DestPath & PLISN & "_" & "*" & PartNum & "*" & ".pdf") <> "" Then
        Cells(i, "C").Value = "File already exists."
    Else
        filename = Dir$(SourcePath & "*" & PartNum & "*" & ".pdf")
        'Copy the file
            FileCopy SourcePath & filename, DestPath & PLISN & "_" & filename
            Cells(i, "C").Value = "File Copied to new location"
    End If



Next i
    End Sub

子移动文件（）
将源路径设置为字符串
将路径设置为字符串
Dim PartNum作为字符串
作为字符串的Dim PLISN
最后一排一样长
我想我会坚持多久
将文件名设置为字符串
LastRow=单元格（Rows.Count，“A”）.End（xlUp）.Row
对于i=3到最后一行
PLISN=单元格（即“E”）.值
PartNum=单元格（i，“B”）。值
如果正确（单元格（i，“A”）.Value，1）Application.PathSeparator，则
SourcePath=单元格（i，“A”）.Value和Application.PathSeparator
其他的
SourcePath=单元格（i，“A”）。值
如果结束
如果正确（单元格（i，“C”）.Value，1）Application.PathSeparator，则
DestPath=单元格（i，“C”）.Value和Application.PathSeparator
其他的
DestPath=单元格（i，“C”）。值
如果结束
如果Dir$（SourcePath&“*”&PartNum&“*”=”）则
单元格（i，“D”）.Value=“源文件不存在。”
ElseIf Dir$（DestPath&PLISN&“&”*”&PartNum&“.pdf”）“然后
单元格（i，“D”）.Value=“文件已存在。”
其他的
filename=Dir$（SourcePath&“*”&PartNum&“*”&“.pdf”）
'复制文件
FileCopy源路径和文件名、DestPath和PLISN&“_ux”和文件名
单元格（i，“D”）.Value=“文件复制到新位置”
如果结束
接下来我
端接头

我不小心在excel工作表的第2行和第3行将我的DestinationPath留空。这就是为什么我只将“\”作为目标路径。现在似乎工作正常

正如下面有人在其中一条评论中提到的，在调试器中单步执行我的代码对解决此问题非常有帮助。我的最终代码有一些结构上的更改，因为我不再有SourcePath和DestPath的列，而是使用文件夹对话框让用户选择这两个列

用于选择我的源文件夹和目标文件夹的代码：

    Sub SourceFolder()
Dim lCount As Long
Dim rCount As Long

SourcePath = vbNullString
DestPath = vbNullString

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = OpenAt
    .Title = "Source Path"
    .Show
    For lCount = 1 To .SelectedItems.Count
        SourcePath = .SelectedItems(lCount)
        MsgBox (SourcePath)
    Next lCount
End With
With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = OpenAt
    .Title = "Destination Path"
    .Show
    For rCount = 1 To .SelectedItems.Count
        DestPath = .SelectedItems(rCount)
        MsgBox (DestPath)
    Next rCount
End With
    End Sub

用于实际转到源路径、搜索位于列A中的文件名（包括前后使用通配符）、将其复制到DestinationPath并使用ColumnB值（后跟下划线）和ColumnA值对其重命名的代码如下：

    Sub MoveFiles()
Dim SourcePath As String
Dim DestPath As String
Dim PartNum As String
Dim PLISN As String
Dim LastRow As Long
Dim i As Long
Dim filename As String

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For i = 3 To LastRow
    PLISN = Cells(i, "E").Value
    PartNum = Cells(i, "B").Value

    If Right(Cells(i, "A").Value, 1) <> Application.PathSeparator Then
        SourcePath = Cells(i, "A").Value & Application.PathSeparator
    Else
        SourcePath = Cells(i, "A").Value
    End If

    If Right(Cells(i, "C").Value, 1) <> Application.PathSeparator Then
        DestPath = Cells(i, "C").Value & Application.PathSeparator
    Else
        DestPath = Cells(i, "C").Value
    End If

    If Dir$(SourcePath & "*" & PartNum & "*") = "" Then
        Cells(i, "D").Value = "Source file does not exist."
    ElseIf Dir$(DestPath & PLISN & "_" & "*" & PartNum & ".pdf") <> "" Then
        Cells(i, "D").Value = "File already exists."
    Else
        filename = Dir$(SourcePath & "*" & PartNum & "*" & ".pdf")
        'Copy the file
        FileCopy SourcePath & filename, DestPath & PLISN & "_" & filename
        Cells(i, "D").Value = "File Copied to new location"
    End If



Next i
     End Sub

    Option Explicit
Public SourcePath As String
Public DestPath As String
Dim PartNum As String
Dim PLISN As String



    Sub MoveFiles()

Dim LastRow As Long
Dim i As Long
Dim filename As String

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For i = 3 To LastRow
    PLISN = Cells(i, "B").Value
    PartNum = Cells(i, "A").Value

    If Right(SourcePath, 1) <> Application.PathSeparator Then
        SourcePath = SourcePath & Application.PathSeparator
    Else
        SourcePath = SourcePath
    End If

    If Right(DestPath, 1) <> Application.PathSeparator Then
        DestPath = DestPath & Application.PathSeparator
    Else
        DestPath = DestPath
    End If

    If Dir$(SourcePath & "*" & "*" & PartNum & "*") = "" Then
        Cells(i, "C").Value = "Source file does not exist."
    ElseIf Dir$(DestPath & PLISN & "_" & "*" & PartNum & "*" & ".pdf") <> "" Then
        Cells(i, "C").Value = "File already exists."
    Else
        filename = Dir$(SourcePath & "*" & PartNum & "*" & ".pdf")
        'Copy the file
            FileCopy SourcePath & filename, DestPath & PLISN & "_" & filename
            Cells(i, "C").Value = "File Copied to new location"
    End If



Next i
    End Sub

选项显式
作为字符串的公共源路径
作为字符串的公共路径
Dim PartNum作为字符串
作为字符串的Dim PLISN
子文件（）
最后一排一样长
我想我会坚持多久
将文件名设置为字符串
LastRow=单元格（Rows.Count，“A”）.End（xlUp）.Row
对于i=3到最后一行
PLISN=单元格（i，“B”）。数值
PartNum=单元格（i，“A”）。值
如果正确（SourcePath，1）Application.PathSeparator，则
SourcePath=SourcePath&Application.PathSeparator
其他的
SourcePath=SourcePath
如果结束
如果正确（DestPath，1）Application.PathSeparator，则
DestPath=DestPath&Application.PathSeparator
其他的
DestPath=DestPath
如果结束
如果Dir$（SourcePath&“*”&“*”&PartNum&“*”=”）则
单元格（i，“C”）.Value=“源文件不存在。”
ElseIf Dir$（DestPath&PLISN&“&”&“*”&PartNum&“*”&“.pdf”）“然后
单元格（i，“C”）.Value=“文件已存在。”
其他的
filename=Dir$（SourcePath&“*”&PartNum&“*”&“.pdf”）
'复制文件
FileCopy源路径和文件名、DestPath和PLISN&“_ux”和文件名
单元格（i，“C”）.Value=“文件复制到新位置”
如果结束
接下来我
端接头

您是否在调试器（F8）中一行一行地运行它以查看它的确切停止位置？使用调试器将对您有很大帮助。或者，（暂时）插入一些

debug.print

语句以查看处理的进度，例如，如果添加

PathSeparator

以及启动/停止

FileCopy

时。特别是，检查

i

的值和

LastRow

的值。我猜

LastRow=3

并且循环仅在运行一次，因为这就是它被告知要做的。感谢弗里曼的建议。通过像你说的那样逐步进行，我清楚地意识到DestinationPath的价值仅为“\“在循环的第二行和第三行。不小心分割了我的评论。但我想继续说，我不小心在excel工作表的第二行和第三行留下了我的DestinationPath空白。这给了我一个“\”作为目标路径。现在似乎工作正常。谢谢！调试器是您的朋友！您可能希望将注释和更新的代码作为答案发布，然后返回以将其标记为已接受。这将帮助下一个正在寻找此问题解决方案的人。