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＆lt;＆gt; 0然后，发送电子邮件功能，但我正在努力！任何帮助都会很棒？

由于

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

VB脚本错误地复制文件和电子邮件

1 个答案: