VBScript SMTP Server

问题:

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_Common\autoemail").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_Common\autoemail\Script\energia-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 

回答1:

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     = "sender@example.com" msg.To       = "recipient@example.org" 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 Server