outlook - VBScript SMTP Server

Question

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

Answer 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     = "[email protected]"
msg.To       = "[email protected]"
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