vba - VB 脚本在出错时复制文件和电子邮件

Question

我有两个 VB 脚本，我试图将它们与中间的错误处理合并。
我有一个效果很好的复制脚本：

    Dim objFSO, colFiles, objFile, strDestFolder, objNewestFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colFiles = objFSO.GetFolder("C:\RD\Source")
strDestFolder = "C:\RD\To\"

For Each objFile In colFiles.Files
    'If Left(objFile.Name, 4) = "apdt" Then
      If objNewestFile = "" Then   
        Set objNewestFile = objFile  
      Else   
          If objNewestFile.DateLastModified < objFile.DateLastModified Then    
            Set objNewestFile = objFile   
          End If  
      End If
    'End If
Next

If Not objNewestFile Is Nothing Then 
    objFSO.CopyFile objNewestFile.Path,strDestFolder,True
End If

还有一个同样有效的电子邮件脚本：

strSMTPFrom = "no-reply@yourcompany.com"
strSMTPTo = "helpdesk@yourcompany.com"
strSMTPRelay = "smtp relay server name or IP address"
strTextBody = "Body of your email"
strSubject = "Subject line"
strAttachment = "full UNC path of file"


Set oMessage = CreateObject("CDO.Message")
oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPRelay
oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
oMessage.Configuration.Fields.Update

oMessage.Subject = strSubject
oMessage.From = strSMTPFrom
oMessage.To = strSMTPTo
oMessage.TextBody = strTextBody
oMessage.AddAttachment strAttachment


oMessage.Send

但我想要一个脚本来复制较新的文件，但如果遇到错误，会通过电子邮件通知我并让我知道。所以我猜我需要添加 If Err <> 0 Then 并使发送电子邮件成为一个功能，但我很挣扎！任何帮助都会很棒？

谢谢

Answer 1

'这是修改后的代码，一旦复制遇到错误，将发送电子邮件：

Dim objFSO, colFiles, objFile, strDestFolder, objNewestFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colFiles = objFSO.GetFolder("C:\RD\Source")
strDestFolder = "C:\RD\To\"

For Each objFile In colFiles.Files
    'If Left(objFile.Name, 4) = "apdt" Then
    If objNewestFile = "" Then   
        Set objNewestFile = objFile  
    Else   
        If objNewestFile.DateLastModified < objFile.DateLastModified Then    
            Set objNewestFile = objFile   
        End If  
    End If
    'End If
Next

If Not objNewestFile Is Nothing Then 
    On Error Resume Next
        objFSO.CopyFile objNewestFile.Path,strDestFolder,True
    If Err<>0 Then

        strSMTPFrom = "no-reply@yourcompany.com"
        strSMTPTo = "helpdesk@yourcompany.com"
        strSMTPRelay = "smtp relay server name or IP address"
        strTextBody = "Error Encountered while trying to copy newest file."
        strTextBody = strTextBody & "Error Message: " & Err.Message
        strSubject = "Subject line"
        strAttachment = "full UNC path of file"


        Set oMessage = CreateObject("CDO.Message")
        oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
        oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPRelay
        oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
        oMessage.Configuration.Fields.Update

        oMessage.Subject = strSubject
        oMessage.From = strSMTPFrom
        oMessage.To = strSMTPTo
        oMessage.TextBody = strTextBody
        oMessage.AddAttachment strAttachment


        oMessage.Send

    End If
End If