VB Code to send an email (1 Viewer)

Option Compare Database
Public Function Xmail(strTo As String, strFrom As String, strSub As String, strBody As String, Optional strAtt As String)

'[This function will let you send email messages via SMTP without involving your local email client, like Outlook.]
'[As such, there is no "sent" history, so this option would not be preferred if you need to have this history.]
'[Requires reference to Microsoft CDO 1.21 Library, though it sometimes works without.]
'[As coded, this only works for unsecured/internal SMTP servers.  However, you can add in login information should you need to.]
'[strAtt is the only optional argument and, if included, must be the full path and extension. Ex: "c:\file.txt"

Set objMessage = CreateObject("CDO.Message")
    objMessage.Subject = strSub
    objMessage.From = strFrom
    objMessage.to = strTo
    objMessage.TextBody = strBody
    objMessage.CC = "[EMAIL="Russell.Neuman@lfg.com"]Russell.Neuman@lfg.com[/EMAIL]"
If Len(strAtt) > 0 Then
    objMessage.AddAttachment strAtt
End If

'==This section provides the configuration information for the remote SMTP server.
'==Normally you will only change the server name or IP.
objMessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/sendusing[/URL]") = 2
'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/smtpserver[/URL]") = "XYZ.us.ad.XYZ.com"
'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("[URL]http://schemas.microsoft.com/cdo/configuration/smtpserverport[/URL]") = 25
objMessage.Configuration.Fields.Update
'==End remote SMTP server configuration section==
objMessage.CC = "XYZ[EMAIL="XYZ@XYZ.com"]@XYZ.com[/EMAIL]"
objMessage.Send
 
End Function

Option Compare Database
' InitOutlook sets up outlookApp and outlookNamespace.
Private outlookApp As Outlook.Application
Private outlookNamespace As Outlook.Namespace
 
Sub InitOutlook()
    ' Initialize a session in Outlook
    Set outlookApp = New Outlook.Application
    
    'Return a reference to the MAPI layer
    Set outlookNamespace = outlookApp.GetNamespace("MAPI")
    
    'Let the user logon to Outlook with the
    'Outlook Profile dialog box
    'and then create a new session
    outlookNamespace.Logon , , True, False
End Sub
 
Sub Cleanup()
    ' Clean up public object references.
    Set outlookNamespace = Nothing
    Set outlookApp = Nothing
End Sub
 
Function SendEmail()
Dim mailItem As Outlook.mailItem
InitOutlook
Set mailItem = outlookApp.CreateItem(olMailItem)
mailItem.To =
mailItem.Subject =
mailItem.Body =
mailItem.Save
mailItem.Close olSave
Set mailItem = Nothing
Cleanup
End Function

Public Sub SendDrafts()
Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder
 
'Send all items in the "Drafts" folder that have a "To" address filled 'in.
'Setup Outlook
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders
'Set Draft Folder.  This will need modification based on where it's 'being run.
Set myDraftsFolder = myFolders("Put your Mailbox name as it appears here").Folders("DRAFTS")
'Loop through all Draft Items
For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1
'Check for "To" address and only send if "To" is filled in.
If Len(Trim(myDraftsFolder.Items.Item(lDraftItem).To)) > 0 Then
'Send Item
myDraftsFolder.Items.Item(lDraftItem).Send
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
DoEvents: DoEvents: DoEvents
End If
Next lDraftItem
'Clean-up
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing

End Sub

Option Compare Database
' InitOutlook sets up outlookApp and outlookNamespace.
Private outlookApp As Outlook.Application
Private outlookNamespace As Outlook.Namespace
 
Sub InitOutlook()
    ' Initialize a session in Outlook
    Set outlookApp = New Outlook.Application
    
    'Return a reference to the MAPI layer
    Set outlookNamespace = outlookApp.GetNamespace("MAPI")
    
    'Let the user logon to Outlook with the
    'Outlook Profile dialog box
    'and then create a new session
    outlookNamespace.Logon , , True, False
End Sub
 
Sub Cleanup()
    ' Clean up public object references.
    Set outlookNamespace = Nothing
    Set outlookApp = Nothing
End Sub
 
Function SendEmail()
Dim mailItem As Outlook.mailItem
InitOutlook
Set mailItem = outlookApp.CreateItem(olMailItem)
mailItem.To =
mailItem.Subject =
mailItem.Body =
mailItem.Save
mailItem.Close olSave
Set mailItem = Nothing
Cleanup
End Function

Option Compare Database
' InitOutlook sets up outlookApp and outlookNamespace.
Private outlookApp As Outlook.Application
Private outlookNamespace As Outlook.Namespace
 
Sub InitOutlook()
    ' Initialize a session in Outlook
    ' [COLOR=red]This starts outlook or just uses the currently open one.[/COLOR]
    Set outlookApp = New Outlook.Application
    
    'Return a reference to the MAPI layer
    ' [COLOR=red]Finds the outlook namespace which it will need to access the object[/COLOR]
    Set outlookNamespace = outlookApp.GetNamespace("MAPI")
    
    'Let the user logon to Outlook with the
    'Outlook Profile dialog box
    'and then create a new session
    outlookNamespace.Logon , , True, False
End Sub
 
Sub Cleanup()
    ' Clean up public object references.
    Set outlookNamespace = Nothing
    Set outlookApp = Nothing
End Sub
 
Function SendEmail()
Dim mailItem As Outlook.mailItem ' [COLOR=red]This creates the object in memory and is defining what type of object we want to work with.[/COLOR]
InitOutlook ' [COLOR=red]This calls the sub above to open outlook or use the current one[/COLOR]
Set mailItem = outlookApp.CreateItem(olMailItem) ' [COLOR=#ff0000]Uses the newly opened outlook or existing one and assigns it to our object that we opened earlier so we can work with it in our current function.[/COLOR]
mailItem.To = ' [COLOR=#ff0000]Sets To field in a message. So the email address should be supplied here.[/COLOR]
mailItem.Subject = ' [COLOR=red]Sets the subject line which the user normally sees first in outlook.[/COLOR]
mailItem.Body = ' [COLOR=red]Sets the contents of the email.[/COLOR]
mailItem.Save ' [COLOR=red]When you call save on a an outlook mail item it automatically saves in your drafts folder.[/COLOR]
mailItem.Close olSave ' [COLOR=red]This closes the mail item and forces it to save just in case the save didn't finish.[/COLOR]
Set mailItem = Nothing ' [COLOR=red]Clears the object from your computer memory so we don't have memory leaks.[/COLOR]
Cleanup ' [COLOR=red]This is the same principle as the one above as its just cleaning up the memory objects and taking them out of your computers memory.[/COLOR]
End Function