Error with sending email through excel

[owentmoore]

I have an excel file that is to open on a scheduled day every week, perform macro tasks, and close again. If there is an error in doing the tasks, I want the program to email me that there has been an error. The code below creates a new file with the heading "Error with Update Consumables.xls". This is then to be emailed to me. I can then see by the email subject line that there was an issue and investigate.

Problem is when opening the email, outlook recognises that a task is attempting to send an email and asks me I want to allow it or not. I thought by setting "Application.DisplayAlerts = False" this would handle it but it doesn't. How can I get around this alert and get outlook to automatically send the mail?

ub Send_Email()


    Application.DisplayAlerts = False
    Workbooks.Add
    ActiveWorkbook.SaveAs FileName:= _
        "C:\Error with Update Consumables.xls" _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    
    ActiveWorkbook.SendMail Recipients:="omoore@dpyie.jnj.com"
    ActiveWorkbook.Close
    Application.DisplayAlerts = False
    
End Sub

 

[SkipVought]

Hi,

Take a look at this function

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 iMsg As Object
    Dim iConf As Object
    Dim Flds As Variant
 
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
 
        iConf.Load -1    ' CDO Source Defaults
        Set Flds = iConf.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 iMsg
        Set .Configuration = iConf
        
        .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 iMsg = Nothing
    Set iConf = 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,

_[red][/red]

 

[PHV]

Do a google search for outlook object model guard

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[cresbydotcom]

just an off the cuff thought but surely if you trap the error with
on error goto xxxx : your statement: 'then at
xxxx: 'do something like read the error number then
on error goto 0 'to clear the trap and
goto yyy '(return to the place where you expect the error).

Multiple errors can be stored in cells, and I haven't used
on error gosub zzz
but I think it would do it.

I use this wheeze when files don't exist or something and put an onscreen message.

remember
on error goto 0
is important as it allows you to see errors that occur during debugging and they don't all go to your special routines.

 

[owentmoore]

Skip

How do I call the function to send a mail?

 

[SkipVought]

Like you'd call any other function...

Dim msg_txt As String, msg_sub As String, msg_to As String

msg_txt = "message text "

msg_sub = "message subject"
msg_to = "SomeOne@SomeMailServer.com"


CdoSend msg_to, "ItsMe@MyMailServer.com", msg_sub, msg_txt

Skip,

_[red][/red]

 

[owentmoore]

Skip

I'm getting an error when I try to send th email. I've deleted the error trapping to see what the message is. It says "The transport failed to connect to the server". I didn't change the code you sent below referencing the server.

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

 

[PHV]

Replace this dfwmail.bh.textron.com with YOUR smtp server ...

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886