컴파일 오류/구문 오류를 어떻게 수정합니까?

Question

루프와 시트의 논리를 이해하려고 노력했습니다. 나는 .pdf 파일을 폴더에서 다른 것으로 옮기려고 노력하고 있는데, 이는 어떤 기준이 엑셀 파일에 있는지 아니면 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 

업데이트 : 문제가 무엇인지는 올바른 시트가 언급되지 않았기 때문에 생각됩니다. 이 업데이트 된 코드를 '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