VBScript SMTP 服务器 [英] VBScript SMTP Server

问题描述

我已将其设置为通过 Outlook 客户端自动发送电子邮件，是否可以更改此代码以直接通过 SMTP 服务器工作?谁能帮我做这件事?

I have set this up to auto email through the Outlook client, is it possible to change this code to work directly through an SMTP server? And could anyone possibly help me do it?

任何帮助将不胜感激，谢谢！

Any help would be much appreciated, thanks!

Set app = CreateObject("Excel.Application")
Set fso = CreateObject("Scripting.FileSystemObject")

For Each f In fso.GetFolder("Y:Billing_Commonautoemail").Files
  If LCase(fso.GetExtensionName(f)) = "xls" Then
    Set wb = app.Workbooks.Open(f.Path)


set sh = wb.Sheets("Auto Email Script")
row = 2
name = "Customer"
email = sh.Range("A" & row)
subject = "Billing"
the = "the"
LastRow = sh.UsedRange.Rows.Count

For r = row to LastRow
    If App.WorkSheetFunction.CountA(sh.Rows(r)) <> 0 Then 
        SendMessage email, name, subject, TRUE, _
        NULL, "Y:Billing_CommonautoemailScriptenergia-logo.gif", 143,393
        row = row + 1
        email = sh.Range("A" & row)
    End if
Next
wb.Close
End If
Next

Sub SendMessage(EmailAddress, DisplayName, Subject, DisplayMsg, AttachmentPath, ImagePath, ImageHeight, ImageWidth)

  ' Create the Outlook session.
  Set objOutlook = CreateObject("Outlook.Application")

  template = FindTemplate()

  ' Create the message.
  Set objOutlookMsg  = objOutlook.CreateItem(0)

  With objOutlookMsg
      ' Add the To recipient(s) to the message.
      Set objOutlookRecip = .Recipients.Add(EmailAddress)
      objOutlookRecip.resolve
      objOutlookRecip.Type = 1

     ' Set the Subject, Body, and Importance of the message.
     .Subject = Subject
     .bodyformat = 3
     .Importance = 2  'High importance

     body = Replace(template, "{First}", name)
     body = Replace(body, "{the}", the)

     if not isNull(ImagePath) then
       if not ImagePath = "" then
         .Attachments.add ImagePath
         image = split(ImagePath,"")(ubound(split(ImagePath,"")))
         body = Replace(body, "{image}", "<img src='cid:" & image & _
         "'" & " height=" & ImageHeight &" width=" & ImageWidth & ">")
       end if
     else
        body = Replace(body, "{image}", "")
     end if

     if not isNull(AttachMentPath) then
       .Attachments.add AttachmentPath
     end if

     .HTMLBody = body
         .Save
         .Send
    End With
    Set objOutlook = Nothing
End Sub

Function FindTemplate()
    Set OL = GetObject("", "Outlook.Application")
    set Drafts = OL.GetNamespace("MAPI").GetDefaultFolder(16)
    Set oItems = Drafts.Items

    For Each Draft In oItems
        If Draft.subject = "Template" Then
            FindTemplate = Draft.HTMLBody
            Exit Function
        End If
    Next
End Function

推荐答案

如果您想直接将邮件发送到 SMTP 服务器，首先无需通过 Outlook.只需使用 CDO.像这样:

If you want to send mail directly to an SMTP server, there's no need to go through Outlook in the first place. Just use CDO. Something like this:

schema = "http://schemas.microsoft.com/cdo/configuration/"

Set msg = CreateObject("CDO.Message")
msg.Subject  = "Test"
msg.From     = "[e-mail]"
msg.To       = "[e-mail]"
msg.TextBody = "This is some sample message text."

With msg.Configuration.Fields
  .Item(schema & "sendusing")      = 2
  .Item(schema & "smtpserver")     = "smtp.intern.example.com"
  .Item(schema & "smtpserverport") = 25
  .Update
End With

msg.Send

这篇关于VBScript SMTP 服务器的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！