Question

详细说明：

我有一个包含大量零件号的excel文件。我想制作一个宏，这样如果一列等于＆＃34;是＆＃34;然后搜索＆＃34; Specs＆＃34;文件夹的规格。 pdf与excel表中的部件号匹配，然后将该文件夹中的.pdf复制到目标文件夹或＆＃34; Dest＆＃34;文件夹中。

更新后的代码试图理解我想要通过的循环逻辑

Sub Rectangle1_Click()

Dim ws As Worksheet
Dim lRow As Long, i As Long
Dim OldPath As String, NewPath As String

Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")



'~~> File location
OldPath = "C:\Users\bucklej\Desktop\Spec\"
NewPath = "C:\Users\bucklej\Desktop\Dest\"

'~~> This is the workbook from where the code is running
 Set ws = ThisWorkbook.Sheets("Specification Listing")

'~~> Loop through Col A
    For i = 1 To 1000
       Cells(i, 2).Value = Yes
    Next i

fso.CopyFile(OldPath, Newpath)

 End Sub

Answer 1

无需使用DIR然后拆分文件名。这是一个更快的方法。

尝试（经过测试和测试）

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, i As Long
    Dim OldPath As String, NewPath As String

    OldPath = "C:\Users\bucklej\Desktop\Test1\"
    NewPath = "C:\Users\bucklej\Desktop\Test2\"

    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = 1 To lRow

            '~~> If file doesn't exists then that line will be ignored
            On Error Resume Next
            LoopFile = .Range("A" & i).Value & ".txt"
            Name OldPath & LoopFile As NewPath & LoopFile
            LoopFile = .Range("A" & i).Value & ".docx"
            Name OldPath & LoopFile As NewPath & LoopFile
            LoopFile = .Range("A" & i).Value & ".xlsx"
            Name OldPath & LoopFile As NewPath & LoopFile
            LoopFile = .Range("A" & i).Value & ".xls"
            Name OldPath & LoopFile As NewPath & LoopFile
            LoopFile = .Range("A" & i).Value & ".bmp"
            Name OldPath & LoopFile As NewPath & LoopFile
            On Error GoTo 0

            DoEvents
        Next i
    End With
End Sub

如何使用宏根据excel文件中的条件将.pdf文件从一个文件夹传输到另一个文件夹？

1 个答案: