PDA

View Full Version : Runtime Error - Email Code



Anomandaris
04-17-2009, 02:44 AM
I'm having trouble with this code that is supposed to send emails from excel......when I press the button that is supposed to send email, it gives me a runtime error, it was working fine before, I dont understand whats wrong now.

Sub SendMailPORT()
Const MatchCode As String = "PORT"
Dim wb As Workbook
Dim LastRow As Long
Dim LastCol As Long
Dim OLApp As Object
Dim EmailItem As Object
Dim EmailRecip As Object
Dim j As Long

With Worksheets("SCORE")

If Range("B1") <> MatchCode Then
MsgBox "Data not for " & MatchCode
Exit Sub
End If
End With

With Worksheets("EMAIL")
Worksheets("SCORE").Copy


Dim shp As Shape
Dim sTopLeft As String
Dim fOK As Boolean

For Each shp In ActiveSheet.Shapes

fOK = True

sTopLeft = ""
On Error Resume Next
sTopLeft = shp.TopLeftCell.Address
On Error GoTo 0

If shp.Type = msoFormControl Then
If shp.FormControlType = xlDropDown Then
If sTopLeft = "" Then
fOK = False 'keep it
End If
End If
End If

If fOK Then
shp.Delete
End If

Next shp

Worksheets("SCORE").Range("H1:H10").Select
Selection.ClearContents

Set wb = ActiveWorkbook
wb.SaveAs "Part of" & ThisWorkbook.Name & "" & ".xls"
wb.ChangeFileAccess xlReadOnly


Set OLApp = CreateObject("Outlook.Application")
Set EmailItem = OLApp.CreateItem(0)

EmailItem.Subject = " Recap - PORT"
LastCol = .Cells(11, .Columns.Count).End(xlToLeft).Column
For j = 2 To LastCol

Set EmailRecip = EmailItem.Recipients.Add(.Cells(11, j).Value)
EmailRecip.Type = 1
Next j

Dim oRecipient As Object
Set oRecipient = _
EmailItem.Recipients.Add(brt@xxx.com)
oRecipient.Type = 2

Dim Msg As String
Msg = "Hello," & vbCrLf & vbCrLf
Msg = Msg & "Confirming the following execution(s):" & vbCrLf & vbCrLf
Msg = Msg & "Thanks,"

EmailItem.Body = Msg

EmailItem.Attachments.Add wb.FullName
EmailItem.Display 'Send

Kill wb.FullName

Set wb = Nothing
Set EmailItem = Nothing
Set OLApp = Nothing
End With
End Sub



Thanks

Anomandaris
04-17-2009, 02:59 AM
This is where the error appears. Some kind of Object defined error.

Set EmailRecip = EmailItem.Recipients.Add(.Cells(11, j).Value)


those are the rows where all the email addresses are listed. Its really weird, it was working before

Anomandaris
04-17-2009, 04:09 AM
Nevermind, Outlook was closed for some of my trial runs so that was the problem.
Then on other ocassions I forgot to close to temporary file, which meant the code was trying to create a file with the same name as one that was already open, hence the error.

I added a code to include the date and time so this eliminates that problem incase someone forgot to close the workbook.

phew that was a relief, hope there's no more trouble
its quite a long and whacky code, but i cant take credit for it, I combined several codes using help from one of the pros here - XLD, thanks again dude