将 PDF 从源文件夹复制到目标文件夹

Question

我想从源文件夹复制 pdf 并且必须粘贴到基于 Excel 的 destpath 中，帮我解决我哪里出错了

Sub CheckandSend()   
    Dim irow As Integer   
    Dim DestPath As String   
    Dim SourcePath As String   
    Dim pfile As String  

    Dim FSO As Object   
    Dim Fldr As Object, f As Object   

    SourcePath = "I:\Mechanical\ExternalProjects\Cummins Emission Systems\35101124 PT Cup Test Rig\16 PDF to Vendor" 
  
    Set FSO = CreateObject("Scripting.FileSystemObject")     
    Set Fldr = FSO.GetFolder(SourcePath).Files 

    DestPath = "P:\CENTRAL PLANNING\PROJECTS 2020-2021\VAM-TARSON\Newfolder1"    

    irow = 7    
    Do While Cells(irow, 2) <> Empty    
        pfile = Dir(SourcePath & "\*" & Cells(irow, 2) & "*")        
        If pfile <> "" And Right(pfile, 3) = "PDF" Then       
            FileCopy SourcePath, DestPath           
            irow = irow + 1           
        End If         
    Loop      
end sub

Answer 1

1. 您正在混合使用 2 种不同的方法：FileSystemObject 和 Dir()。只使用其中一种。

2. FileCopy SourcePath, DestPath 只复制路径，没有文件名。

3. 在Dir() 中直接包含文件扩展名，这样您就无需检查 pdf 文件：

   FileName = Dir(SourcePath & "*" & ws.Cells(iRow, 2) & "*.pdf")
   

4. 可能存在多个文件，其中包含您单元格中的关键字。您的代码随机复制其中之一。确保循环，以便获得所有这些

   Do While FileName <> vbNullString 'if more files with the key word from ws.Cells(iRow, 2) exist copy all of them
       VBA.FileCopy SourcePath & pfile, DestPath 'copy needs to be path AND filename
       FileName = Dir()
   Loop
   

它可能看起来像这样：

Option Explicit

Public Sub CheckandSend()
    Dim ws As Worksheet 'make sure to define a sheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim SourcePath As String
    SourcePath = "C:\Temp\" 'make sure paths end with \

    Dim DestPath As String
    DestPath = "P:\CENTRAL PLANNING\PROJECTS 2020-2021\VAM-TARSON\Newfolder1\" 'make sure paths end with \
    
    Dim iRow As Long
    iRow = 7
    
    Do While ws.Cells(iRow, 2) <> vbNullString
        Dim FileName As String
        FileName = Dir(SourcePath & "*" & ws.Cells(iRow, 2) & "*.pdf") 'this will only go through pdf files
        
        Do While FileName <> vbNullString 'if more files with the key word from ws.Cells(iRow, 2) exist copy all of them
            VBA.FileCopy SourcePath & pfile, DestPath 'copy needs to be path AND filename
            FileName = Dir()
        Loop
        
        iRow = iRow + 1
    Loop
End Sub

Answer 2

下面的代码有效。

Sub CheckandSend()
    ' 191

    Const Ext           As String = ".pdf"
    Dim SourcePath      As String
    Dim DestPath        As String
    Dim FSO             As Object
    Dim Fldr            As Object
    Dim pFile As String
    Dim f As Object
    Dim iRow            As Long             ' row numbers should be declared as Long
    
    ' both paths must end on backslash ("\")
    SourcePath = "I:\Mechanical\ExternalProjects\Cummins Emission Systems\35101124 PT Cup Test Rig\16 PDF to Vendor\"
    DestPath = "P:\CENTRAL PLANNING\PROJECTS 2020-2021\VAM-TARSON\Newfolder1\"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Fldr = FSO.GetFolder(SourcePath).Files
    
    ' loop until last used cell in column B
    For iRow = 7 To Cells(Rows.Count, 2).End(xlUp).Row
        pFile = Trim(Cells(iRow, 2).Value)
        If Len(pFile) = 0 Then Exit For     ' exit at first blank row
        
        If LCase(Right(pFile, 4)) <> Ext Then pFile = pFile & Ext
        If Len(Dir(SourcePath & pFile)) Then
            FileCopy SourcePath & pFile, DestPath & pFile
        End If
    Next iRow
End Sub

我已经消除了您的程序中的一些不一致之处。例如，您的代码不清楚工作表中的文件名是否具有 pdf 扩展名，然后查找具有该名称的任何文件，但拒绝所有不是“pdf”的文件。上面的代码将其改写为意味着您想要一个 PDF 文件，其名称为工作表中的名称，任何文件名称相同但另一个扩展名将被忽略。我认为它是相同的，但如果将搜索限制为 PDF，效率会更高。

另一件事是循环的结束。是没有更多文件名还是单元格为空白时？上面的代码在任何一种情况下都结束。我认为这没问题，因为您的文件列表中没有空白。但是，如果是这样，最好跳过任何意外的空白并继续直到处理完最后一行。如果您同意，请删除Exit For 并在适当的位置（Next iRow 之前）设置End If，并缩进其间的所有行。