[已解决]老铁们，怎么在这段代码加个条件

代码小菜鸟

Sub 快速查找文件并复制()
    Dim MyPath1 As String, MyPath2 As String, MyName As String, MyName2 As String
    MyPath1 = "\\192.168.10.91\采购共享\未发送订单\"  '指定原始文件所在文件夹
    MyPath2 = "\\192.168.10.91\采购共享\已发送订单2023年\"    '指定文件新文件夹，需要事先创建该文件夹
    MyName1 = Dir(MyPath1 & "*BN*")     ' 找寻第一项。
    Do While MyName1 <> ""      ' 开始循环。
        Name MyPath1 & MyName1 As MyPath2 & MyName1   '移动文件
        MyName1 = Dir    ' 查找下一个目录。
    Loop
MsgBox "执行完毕！"
End Sub

老铁们，在这段代码中加个条件，未发送订单文件夹中名称与当前运行表格内W列一致的则复制到已发送订单2023年，如果名称不一致的保持不动

最佳答案

月排行榜 / 总排行榜

psxk3535028-1

2023-8-6 05:11

把w列赋值给arr，在arr中查找文件名是否在arr中，在，就移动，不在，就不动

Sub 快速查找文件并复制()
    Dim MyPath1 As String, MyPath2 As String, MyName As String, MyName2 As String
    Arr = Range("w1:w" & Cells(Rows.Count, "w").End(3).Row)
    MyPath1 = "\\192.168.10.91\采购共享\未发送订单\"  '指定原始文件所在文件夹
    MyPath2 = "\\192.168.10.91\采购共享\已发送订单2023年\"    '指定文件新文件夹，需要事先创建该文件夹
    MyName1 = Dir(MyPath1 & "*BN*")     ' 找寻第一项。
    Do While MyName1 <> ""      ' 开始循环。
    On Error GoTo 100
If Application.Match(MyName1, Arr, 0) > 0 Then
        Name MyPath1 & MyName1 As MyPath2 & MyName1   '移动文件
End If
100
        MyName1 = Dir    ' 查找下一个目录。
    Loop
MsgBox "执行完毕！"
End Sub

跳转到最佳答案楼层

psxk3535028-1

把w列赋值给arr，在arr中查找文件名是否在arr中，在，就移动，不在，就不动

Sub 快速查找文件并复制()
    Dim MyPath1 As String, MyPath2 As String, MyName As String, MyName2 As String
    Arr = Range("w1:w" & Cells(Rows.Count, "w").End(3).Row)
    MyPath1 = "\\192.168.10.91\采购共享\未发送订单\"  '指定原始文件所在文件夹
    MyPath2 = "\\192.168.10.91\采购共享\已发送订单2023年\"    '指定文件新文件夹，需要事先创建该文件夹
    MyName1 = Dir(MyPath1 & "*BN*")     ' 找寻第一项。
    Do While MyName1 <> ""      ' 开始循环。
    On Error GoTo 100
If Application.Match(MyName1, Arr, 0) > 0 Then
        Name MyPath1 & MyName1 As MyPath2 & MyName1   '移动文件
End If
100
        MyName1 = Dir    ' 查找下一个目录。
    Loop
MsgBox "执行完毕！"
End Sub