Sending Email from Excel Using Microsoft Outlook - Late Binding

[EliseFreedman]

HI There

For a few weeks now, we have been using an excel form which users fill in and then click a submit button which automatically emails the completed form to us. Until now this has worked perfectly. However, I am now running into problems as we are in the midst of an upgrade to Office 2010. Some users are still using Office 2003. When they try to send the email they are getting an error as it is looking for the outlook14 object library.

I googled a bit and tried changing my code to use late binding. However, I am getting an error message when I run the code. The code works fine until it gets to the .To line when it says Run Time error 438 object does not support this method.

Can anyone help

Sub Outlookmessage()
Const OLMAILITEM = 3    ' Outlook VBA constant olMailItem
Dim OutlookApp As Object
Dim MyItem As Object
Dim EmailAddr As String
Dim ccAddress As String
Dim Subj As String
Dim Sender As String
Dim Msg As String
    Set OutlookApp = CreateObject("Outlook.Application")
    
    Set MyItem = OutlookApp.CreateItem(OLMAILITEM)
    
    EmailAddr = "elise.freedman@baesystems.com"
    'ccAddress = UserForm1.Label2.Caption
    Subj = "SHE Improvement Suggestion"
        
    Msg = "Please find attached a SHE Improvement Suggestion" & vbCrLf & vbCrLf
  
   
    
    With MyItem
        .To = EmailAddr
                   
        .Subject = Subj
        .Body = Msg
  .Attachments.Add myfile2
   .Attachments.Add myfile
.Send
    End With
    
 End If
 End If

 

[SkipVought]

Elsie,

I use the CDO object. You avoid several issues that come with the Outlook application object...

Sub dx()
    Dim msg_txt As String, msg_sub As String, msg_to As String
    
    msg_txt = "message text "
    
    msg_sub = "message subject"
    msg_to = "someid@someserver.com"
    
    
    CdoSend msg_to, "msg_to, msg_sub, msg_txt"


End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function CdoSend(MailTo As String, MailFrom As String, Subject As String, MessageText As String, Optional CC As String, Optional BCC As String, Optional FileAttachment As String) As Boolean
On Error GoTo CdoSend_Err

' This example use late binding, you don't have to set a reference
' You must be online when you run the sub
    Dim oMsg As Object
    Dim oConf As Object
    Dim Flds As Variant
 
    Set oMsg = CreateObject("CDO.Message")
    Set oConf = CreateObject("CDO.Configuration")
 
        oConf.Load -1    ' CDO Source Defaults
        Set Flds = oConf.Fields
        With Flds
            .Item("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/sendusing")[/URL] = 2
            .Item("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserver")[/URL] = "dfwmail.bh.textron.com"
            .Item("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserverport")[/URL] = 25
            .Update
        End With
 
    With oMsg
        Set .Configuration = oConf
        
        .To = MailTo
        .CC = CC
        .BCC = BCC
        .FROM = MailFrom
        
        .Subject = Subject
        .TextBody = MessageText

        
        If Len(FileAttachment & "") > 0 Then
            
            '## Last make sure the file actually exists and send it!:
            Dim fso
            Set fso = CreateObject("Scripting.FileSystemObject")
            If fso.FileExists(FileAttachment) Then
                .AddAttachment FileAttachment
            Else
                'otherwise return that the send failed and exit function:
                Debug.Print "[CdoSend.Error]=> File attachment path does not exist, quitting..."
                CdoSend = False
                Exit Function
            End If
        
        End If
    
        '## Send zee message! ##
        .sEnd
    
    End With

    Set fso = Nothing
    Set oMsg = Nothing
    Set oConf = Nothing
    
    CdoSend = True

CdoSend_Exit:
    Exit Function
    
CdoSend_Err:
    Debug.Print "[CdoSend.Error(" & Err.Number & ")]=> " & Err.Description
    CdoSend = False
    Resume CdoSend_Exit
End Function

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[EliseFreedman]

Hi Skip

I have tried running your code but I get an argument not optional error at the following line CdoSend msg_to, "msg_to, msg_sub, msg_txt

 

[strongm]

Probably becasue it should read something like:

[blue]CdoSend msg_to, "fromsomeone@somewhere", msg_sub, msg_txt[/blue]

 

[SkipVought]

sorry, don't know where those quotes snuck in.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}