Runtime error 2147467259 (80004005)

[Pobek]

Hi,

I have an excel template that sends emails. When I wrote the code it was working fine. Then it seemed to freeze outlook at some point after which excel crashed. On reopening, the code gives me said runtime error at the ".Send" part of the code below :


Sub SendRunRequest()

Dim Msg As String
Dim olApp As Object
Dim olEmail As Object
Dim SendAt As String
Dim SendTo As String
Dim Sendcc As String
Dim Subj As String

Dim resp As Long

Calculate




recipient = Range("g4").Value
ReqCC = Range("g5").Value
subje = Range("g8").Value
mes = Range("mes").Value

QsDay = Range("daytoday").Value
QsMonth = Range("Monthtoday").Value
QsYear = Range("Yeartoday").Value

attachepath = Range("QSRepPath").Value
attache = Range("QSRepfile").Value


attchmnt = attachepath & "" & attache & " " & QsDay & "-" & QsMonth & "-" & QsYear & ".xlsb"


SendTo = recipient
Sendcc = ReqCC
Subj = subje
Msg = mes

'SendAt = "10/19/2008 12:30am" 'Date-Time must be in this format

On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err = 429 Then
Err.Clear
Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
olApp.Session.Logon

Set olEmail = olApp.CreateItem(olMailItem)
With olEmail
' .DeferredDeliveryTime = SendAt
.To = SendTo
.cc = Sendcc
.Subject = Subj
.Body = Msg
'MsgBox (attchmnt)
.attachments.Add (attchmnt)

resp = MsgBox(Prompt:="Are you sure you want to send off this email?", _
Buttons:=vbYesNo, Title:="Warning")

If resp = vbYes Then
.Send
MsgBox "Email sent!"
End If

End With

olApp.Session.Logoff

Set olApp = Nothing
Set olEmail = Nothing


End Sub

 

[areed1192]

This usually happens because one of the people you are trying to send it to no longer has that email. What we would want to do is check the validity of that email contact.

Adding this to your code will check whether that contact info is still valid.

set r = .Recipients.Add(Range("G4").Value
If Not r.Resolve Then r.Delete[/FONT][/COLOR][COLOR=#303336][FONT=inherit]
[/FONT][/COLOR]