Question

此脚本正确运行以发送电子邮件SQL查询结果，但如果SQL查询结果为空，我需要脚本停止发送电子邮件。

'Declare Constants

Const CDO_SCHEMA = "http://schemas.microsoft.com/cdo/configuration/"
Const CDO_MAIL_HEADER = "urn:schemas:mailheader:"

'Method used to send mail
Const CDO_SEND_USING_REMOTE = 2 'Send using Remote SMTP Server

'Security method used on remote SMTP server
Const CDO_ANONYMOUS = 0 'Use no authentication
Const CDO_BASIC = 1 'Use the basic (clear text) authentication
Const CDO_NTLM = 2 'Use the NTLM authentication

'Delivery Status Notifications
Const cdoDSNDefault = 0 'No DSN commands are issued
Const cdoDSNNever = 1 'No DSN commands are issued
Const cdoDSNFailure = 2 'Return a DSN if delivery fails
Const cdoDSNSuccess = 4 'Return a DSN if delivery succeeds
Const cdoDSNDelay = 8 'Return a DSN if delivery is delayed
Const cdoDSNSuccessFailOrDelay = 14 'Return a DSN if delivery succeeds, fails, or is delayed

'Set method of sending
strSendMethod = CDO_SEND_USING_REMOTE

'Remote SMTP Server Settings
strSmtpServer = "smtp.abc.com" 'Name or IP of SMTP Server
intSmtpPort = 25 'SMTP Server Port; typically 25
intSmtpTimeout = 60 'Number of seconds to try establishing a connection to the SMTP Server
strAuthenticationMethod = CDO_ANONYMOUS

'SMTP Server Authentication - IF BASIC or NTLM; NOT needed for ANONYMOUS
strUserName = ""
strPassword = ""
strUserSSL = False 'True if SMTP Server uses SSL; False if Not

'Message Settings
strTo = "asdf@abc.com"
'Separate multiple addresses with a semi-colon (;)
strCC = ""
strBCC = ""
strFrom = "no-reply-SalesInfo@abc.com"
strSubject = "Pending Sales Order - Perlu di follow up"
strBodyType = "TEXT"
strAttachment = "D:\File.txt" 'Attachment Path i.e. C:\Temp\File.txt
strDSNotification = cdoDSNDefault 'Delivery Status Option Change as needed

'WScript.Echo "Connecting to database..."

'Connect to database & select all from Table
Set objDB = DBConnect()
Set oRS = objDB.Execute("SELECT S_ORDER 'SO#               ',CUSTOMER_NAME'CUSTOMER          ',DATE 'Tanggal           ',USERID 'INTERNAL          ',CALLING 'Approval from     ',LIMIT 'LIMIT             ',TERM 'TERM              ' from abc")

'Dump Records from Table
strOutput = "Please Check This Report :"  & vbCrLf
nRec = 1
Do While Not oRS.EOF
    strOutput = strOutput & "----- " & nRec & " -----" & vbCrLf
    nRec = nRec + 1
    For Each oFld In oRS.Fields
        strOutput = strOutput & oFld.Name & " = " & oFld.Value & vbCrLf
    Next
    oRS.MoveNext
Loop

SendEmail strOutput

'WScript.Echo "Script Finished"

'This function sets up DB Connection using specified DSN
Function DBConnect
    Set objDB = CreateObject("ADODB.Connection")
    objDB.Open "DSN=SQL;uid=sa;pwd=12345"
    'Set Conn = Server.CreateObject("ADODB.Connection")
  'Conn.open "SQL","sa","12345"
  Set DBConnect = objDB
End Function

Sub SendEmail(strBody)
    'Create Objects
    Set objConfig = CreateObject("CDO.Configuration")
    Set objEmail = CreateObject("CDO.Message")

    'Prepare email configuration
    With objConfig.Fields
        .Item(CDO_SCHEMA & "sendusing") = strSendMethod
        .Item(CDO_SCHEMA & "smtpserver") = strSmtpServer
        .Item(CDO_SCHEMA & "smtpserverport") = intSmtpPort
        .Item(CDO_SCHEMA & "smtpconnectiontimeout") = intSmtpTimeout
        .Item(CDO_SCHEMA & "smtpauthenticate") = strAuthenticationMethod

        If.Item(CDO_SCHEMA & "smtpauthenticate") <> 0 Then
            .Item(CDO_SCHEMA & "sendusername") = strUsername
            .Item(CDO_SCHEMA & "sendpassword") = strPassword
            .Item(CDO_SCHEMA & "smtpusessl") = strUserSSL
        End If
        .Update
    End With

    'Create email and send
    With objEmail
        Set.Configuration = objConfig

        .To = strTo

        If strCC <> "" Then
            .CC = strCC
        End If

        If strBCC <> "" Then
            .BCC = strBCC
        End If

        .From = strFrom

        .Subject = strSubject

        If strBodyType = "HTML" Then
            .HTMLBody = strBody
        ElseIf strBodyType = "TEXT" Then
            .TextBody = strBody
        End If

        If strAttachment <> "" Then
            .AddAttachment strAttachment
        End If

        If strDSNotification <> 0 And strDSNotification <> 1 Then
            .Fields(CDO_MAIL_HEADER & "disposition-notification-to") = strFrom
            .Fields(CDO_MAIL_HEADER & "return-receipt-to") = strFrom
            .DSNOptions = strDSNotification
            .Fields.update
        End If

        .Send
    End With
End Sub

Answer 1

根据您的查询是否返回记录，只需发送电子邮件。

更改此行：

SendEmail strOutput

进入这个：

If nRec > 1 Then SendEmail strOutput

Answer 2

通过以下条件如果oRS.RecordCount> 0或oRS则不是Nothing 您将能够控制发送的电子邮件。

尝试以下方法：

Const CDO_SCHEMA = "http://schemas.microsoft.com/cdo/configuration/"
Const CDO_MAIL_HEADER = "urn:schemas:mailheader:"

'Method used to send mail
Const CDO_SEND_USING_REMOTE = 2 'Send using Remote SMTP Server

'Security method used on remote SMTP server
Const CDO_ANONYMOUS = 0 'Use no authentication
Const CDO_BASIC = 1 'Use the basic (clear text) authentication
Const CDO_NTLM = 2 'Use the NTLM authentication

'Delivery Status Notifications
Const cdoDSNDefault = 0 'No DSN commands are issued
Const cdoDSNNever = 1 'No DSN commands are issued
Const cdoDSNFailure = 2 'Return a DSN if delivery fails
Const cdoDSNSuccess = 4 'Return a DSN if delivery succeeds
Const cdoDSNDelay = 8 'Return a DSN if delivery is delayed
Const cdoDSNSuccessFailOrDelay = 14 'Return a DSN if delivery succeeds, fails, or is delayed

'Set method of sending
strSendMethod = CDO_SEND_USING_REMOTE

'Remote SMTP Server Settings
strSmtpServer = "smtp.abc.com" 'Name or IP of SMTP Server
intSmtpPort = 25 'SMTP Server Port; typically 25
intSmtpTimeout = 60 'Number of seconds to try establishing a connection to the SMTP Server
strAuthenticationMethod = CDO_ANONYMOUS

'SMTP Server Authentication - IF BASIC or NTLM; NOT needed for ANONYMOUS
strUserName = ""
strPassword = ""
strUserSSL = False 'True if SMTP Server uses SSL; False if Not

'Message Settings
strTo = "asdf@abc.com" 
'Separate multiple addresses with a semi-colon (;)
strCC = ""
strBCC = ""
strFrom = "no-reply-SalesInfo@abc.com"
strSubject = "Pending Sales Order - Perlu di follow up"
strBodyType = "TEXT"
strAttachment = "D:\File.txt" 'Attachment Path i.e. C:\Temp\File.txt
strDSNotification = cdoDSNDefault 'Delivery Status Option Change as needed

'WScript.Echo "Connecting to database..."

'Connect to database & select all from Table
Set objDB = DBConnect()
Set oRS = objDB.Execute("SELECT S_ORDER 'SO#               ',CUSTOMER_NAME'CUSTOMER          ',DATE 'Tanggal           ',USERID 'INTERNAL          ',CALLING 'Approval from     ',LIMIT 'LIMIT             ',TERM 'TERM              ' from abc")
if oRS.RecordCount>0 or oRS is Not Nothing then
'Dump Records from Table
strOutput = "Please Check This Report :"  & vbCrLf
nRec = 1
Do While Not oRS.EOF
    strOutput = strOutput & "----- " & nRec & " -----" & vbCrLf 
    nRec = nRec + 1
    For Each oFld In oRS.Fields
        strOutput = strOutput & oFld.Name & " = " & oFld.Value & vbCrLf
    Next
    oRS.MoveNext
Loop

SendEmail strOutput
end if

'WScript.Echo "Script Finished"

'This function sets up DB Connection using specified DSN
Function DBConnect
    Set objDB = CreateObject("ADODB.Connection")
    objDB.Open "DSN=SQL;uid=sa;pwd=12345"
    'Set Conn = Server.CreateObject("ADODB.Connection")
    'Conn.open "SQL","sa","12345"
    Set DBConnect = objDB
End Function

Sub SendEmail(strBody)
    'Create Objects
    Set objConfig = CreateObject("CDO.Configuration")
    Set objEmail = CreateObject("CDO.Message")

    'Prepare email configuration
    With objConfig.Fields
        .Item(CDO_SCHEMA & "sendusing") = strSendMethod
        .Item(CDO_SCHEMA & "smtpserver") = strSmtpServer
        .Item(CDO_SCHEMA & "smtpserverport") = intSmtpPort
        .Item(CDO_SCHEMA & "smtpconnectiontimeout") = intSmtpTimeout
        .Item(CDO_SCHEMA & "smtpauthenticate") = strAuthenticationMethod

        If.Item(CDO_SCHEMA & "smtpauthenticate") <> 0 Then
            .Item(CDO_SCHEMA & "sendusername") = strUsername
            .Item(CDO_SCHEMA & "sendpassword") = strPassword
            .Item(CDO_SCHEMA & "smtpusessl") = strUserSSL
        End If
        .Update
    End With

    'Create email and send
    With objEmail
        Set.Configuration = objConfig

        .To = strTo

        If strCC <> "" Then
            .CC = strCC
        End If

        If strBCC <> "" Then
            .BCC = strBCC
        End If

        .From = strFrom

        .Subject = strSubject

        If strBodyType = "HTML" Then
            .HTMLBody = strBody
        ElseIf strBodyType = "TEXT" Then
            .TextBody = strBody
        End If

        If strAttachment <> "" Then
            .AddAttachment strAttachment
        End If

        If strDSNotification <> 0 And strDSNotification <> 1 Then
            .Fields(CDO_MAIL_HEADER & "disposition-notification-to") = strFrom
            .Fields(CDO_MAIL_HEADER & "return-receipt-to") = strFrom
            .DSNOptions = strDSNotification
            .Fields.update
        End If

        .Send
    End With
End Sub

如果SQL查询结果为空，则发送电子邮件

2 个答案: