Как исправить ошибку компиляции/ошибку синтаксиса?

Question

Я пробовал понимать логику цикла и моего листа. Я пытаюсь получить файлы .pdf, перенесенные из папки в другую, исходя из того, какие критерии находятся в файле excel, или столбец H = YES. я получаю ошибку синтаксиса вниз в нижней части кода

**objFSO.CopyFile Source:=OldPath & Range("H"&CStr(iRow)).Value & sFileType, 
Destination:=NewPath** 


Sub Rectangle1_Click() 
Dim iRow As Integer 
Dim OldPath As String 
Dim NewPath As String 
Dim sFileType As String 

Dim bContinue As Boolean 

bContinue = True 
iRow = 2 

' The Source And Destination Folder With Path 

OldPath = "C:\Users\bucklej\Desktop\Spec\" 
NewPath = "C:\Users\bucklej\Desktop\Dest\" 

sFileType = ".pdf" 

'Loop Through Column "H" To Pick The Files 
While bContinue 

If Len(Range("H" & CStr(iRow)).Value) = Yes Then 
MsgBox "Files Copied" 
bContinue = False 

Else 

Range("H" & CStr(iRow)).Value = "No" 
Range("H" & CStr(iRow)).Font.Bold = False 

If Trim(NewPath) <> "" Then 
Set objFSO = CreateObject("scripting.filesystemobject") 

'Check if destination folder exsists 

If objFSO.FolderExists(NewPath) = False Then 
MsgBox NewPath & "Does Not Exist" 
Exit Sub 
End If 

'Using CopyFile Method to copy the files 
Set objFSO = CreateObject("scripting.filesystemobject") 
objFSO.CopyFile Source:=OldPath & Range("H"&CStr(iRow)).Value & sFileType, 
Destination:=NewPath 

    End If 
    End If 
    End If 

    iRow = iRow + 1 

    Wend 
End Sub 

ПРАВИЛЬНЫЙ КОД перечислены ниже:

Sub Rectangle1_Click() 

Dim OldPath As String, NewPath As String 

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

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

Set ws = ThisWorkbook.Sheets("Specification Listing") 
Range("A2").Activate '<--- to make sure we're starting at the right spot 

For i = 2 To 1000 
    If Cells(i, 8).Value = "YES" Then '<--- correct, 8th column over 
    On Error GoTo ErrHandle 
     fso.CopyFile OldPath & Cells(i, 1).Value & ".pdf", NewPath 
    End If 
Next i 

ErrHandle: 
ws.Cells(i, 11).Value = "File Not Found" 
Resume Next 



End Sub 

Answer 1

оглядки на второй дублированный вопрос и фрагмент кода при условии, как ответ я вижу вы сказали, что вы получили сообщение об ошибке, и разговор закончился. Развернувшись на этом ответе, я смог заставить следующее работать с помощью test.txt. Вы должны уметь это подстраивать под свои нужды.

Sub Rectangle1_Click() 


Dim OldPath As String, NewPath As String 

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

'~~> File location 
OldPath = "C:\Users\me\Desktop\" 
NewPath = "C:\Users\me\Desktop\Test\" 

For i = 1 To 1000 
    If Cells(i, 2).Value = "yes" Then 
     fso.copyfile OldPath & Cells(i, 3).Value & ".txt", NewPath 
    End If 
Next i 


End Sub 

UPDATE: Я думаю, что (возможно), что проблема заключается в том, что, поскольку он не делает ничего правый лист не идет речь. Вставьте этот обновленный код в «ThisWorkbook» и переименуйте имя листа в коде.

Sub Rectangle1_Click() 

Dim OldPath As String, NewPath As String 
Dim ws As Worksheet 
Dim wb As Workbook 
Dim fso As Object 
Set fso = VBA.CreateObject("Scripting.FileSystemObject") 

Set wb = ActiveWorkbook 
Set ws = wb.Worksheets("Test") <--rename to the sheet that has the parts numbers 

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

For i = 1 To 1000 
    If ws.Cells(i, 2).Value = "YES" Then 
     fso.CopyFile OldPath & Cells(i, 3).Value & ".pdf", NewPath 
    End If 
Next i 


End Sub 

еще раз, не стесняйтесь, напишите мне.

UPDATE: Окончательный вариант с обработкой ERR выброшен в

Sub Rectangle1_Click() 

Dim OldPath As String, NewPath As String 

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

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

Set ws = ThisWorkbook.Sheets("Specification Listing") 
Range("A2").Activate 

For i = 2 To 1000 
    If Cells(i, 8).Value = "YES" Then 
    On Error GoTo ErrHandle 
     fso.CopyFile OldPath & Cells(i, 1).Value & ".pdf", NewPath 
    End If 
Next i 

ErrHandle: 
ws.Cells(i, 11).Value = "File Not Found" 

Resume Next 

End Sub