0

途中でエラー処理を行ってマージしようとしている 2 つの 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 を追加してメール送信を関数にする必要があると思いますが、苦労しています! どんな助けでもいいですか？

ありがとう

4

1 に答える 1

0

'コピー中にエラーが発生した場合に電子メールを送信する変更されたコードは次のとおりです。

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
于 2012-10-22T10:55:50.117 に答える