Comment corriger une erreur de compilation/syntaxe?

Question

J'ai essayé de comprendre la logique de la boucle et de ma feuille. J'essaie d'obtenir des fichiers .pdf transférés d'un dossier à un autre en fonction des critères d'un fichier Excel ou de la colonne H = YES. je reçois une erreur de syntaxe au bas du code

**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 

CODE CORRECT ci-dessous:

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

regardant en arrière à la deuxième question en double et l'extrait de code fourni comme réponse que je vois vous avez dit que vous receviez une erreur msg et la conversation est morte. En développant cette réponse, j'ai pu obtenir ce qui suit en utilisant un test.txt. Vous devriez être en mesure d'ajuster cela à vos besoins.

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 

MISE À JOUR: Je pense (peut-être) ce que la question est que puisqu'il n'y a rien à faire la feuille droit ne soit pas référencé. Collez ce code mis à jour dans le 'ThisWorkbook' et renommez le nom de la feuille dans le code.

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 

encore, n'hésitez pas à m'envoyer un courriel.

MISE À JOUR: La version finale à la manipulation err Renvoyé dans

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