vba 如何修复编译错误/语法错误？

How do i fix a Compile error/ Syntax error?

提问by Joshua Buckley

I've tried understanding the logic of the loop and my sheet. I'm trying to get .pdf files transferred from a folder to another based off of what criteria is in an excel file, or column H = YES. I get a syntax error down at the bottom of the code

我试过理解循环和我的工作表的逻辑。我正在尝试根据 excel 文件中的标准或列 H = YES 将 .pdf 文件从一个文件夹传输到另一个文件夹。我在代码底部收到一个语法错误

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

CORRECT CODE listed below:

下面列出了正确的代码：

 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

回答by mrbungle

looking back at the second duplicate question and the snippet of code provided as an answer I see you said you were getting an error msg and the conversation went dead. Expanding on that answer I was able to get the following to work using a test.txt. You should be able to tweak this to your needs.

回顾第二个重复的问题和作为答案提供的代码片段，我看到您说您收到错误消息并且对话停止了。扩展该答案，我能够使用 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: I think (maybe) what the issue is is that since it's doing nothing the right sheet isn't being referenced. Paste this updated code in the 'ThisWorkbook' and rename the sheet name in the code.

更新：我认为（也许）问题是因为它什么都不做，所以没有引用正确的工作表。将此更新后的代码粘贴到“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

again, feel free to email me.

再次，随时给我发电子邮件。

UPDATE: Final version with err handling thrown in

更新：带有错误处理的最终版本

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