Trouble using Outlook Automation

[MR Campbell]

I am trying to get my Excel macro (code shown below) to automate Outlook by sending some emails in a loop but invariably in the middle of running this, the programme hangs. I have no idea why this happens.

When this technique is used, I am not sure whether I am supposed to have Outlook running already or not. When the Outlook application object is used does it matter whether Outlook is running or not ?

I would envisage the user clicks a button and emails are sent using Outlook using this macro, with the email addresses and other details are already stored with my Excel workbook.

Please help me !!


Private Sub SendMailviaOutlook()
'Sends a general email message to ALL Parents from the screen parameters via OUTLOOK


Dim OutlookApp As Outlook.Application 'outlook application object
Dim MailItem As Outlook.MailItem 'outlook mail object

Dim DOBRow As Integer 'row number in the DOB Squad sheet
Dim EmailsSent As Integer 'counts the number of emails sent

Dim Title As String 'Email title
Dim ReturnAdd As String 'Return email address
Dim Attach As String 'Attachment file and location

Dim TextBody As String 'main text for the Parent Email
Dim ParentSalutation As String 'parent saluatation e.g. Mr and Mrs SMITH
Dim EmailAddress As String 'parent email address

Dim Para1 As String 'paragraph 1 read from the Pem sheet
Dim Para2 As String 'paragraph 2 read from the Pem sheet
Dim Para3 As String 'paragraph 3 read from the Pem sheet
Dim SignOff As String 'sign off text e.g. Yours sincerely,
Dim SenderName As String 'personal name of the sender e.g. Grahame Lowe
Dim Position As String 'Position e.g. Head Coach
Dim SchoolName As String 'name of school e.g. Hale School

'Erase SENT emails message
Sheets("Pem").Range("j30").Value = ""

EmailsSent = 0 'initialise NO emails yet sent
DOBRow = 6 'first row to examine in the DOB squad sheet
SquadNum = Sheets("DOB").Range("TotalNum").Value 'number students in the squad

'Create Outlook object
'Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookApp = New Outlook.Application

'Read the parameters for each email
With Sheets("Pem")
Title = .Range("Title").Value 'email title
ReturnAdd = .Range("ReturnAdd").Value 'return email address
Attach = .Range("Attach").Value 'attachment file
Para1 = .Range("Para1").Value
Para2 = .Range("Para2").Value
Para3 = .Range("Para3").Value
SignOff = .Range("SignOff").Value
SenderName = .Range("SenderName").Value
Position = .Range("Position").Value
SchoolName = .Range("SchoolName").Value
End With

'Compose the main body of the Email
TextBody = Para1 & vbCrLf & vbCrLf & Para2 & vbCrLf & vbCrLf & Para3 & vbCrLf & vbCrLf & _
SignOff & vbCrLf & SenderName & vbCrLf & vbCrLf & Position & vbCrLf & SchoolName

'Read each row in the DOB Squad Sheet a
For DOBRow = 6 To SquadNum + 5
EmailAddress = Sheets("DOB").Cells(DOBRow, 30).Value 'parent email address in col 23

'Test if there is an email address
If EmailAddress <> "" Then
ParentSalutation = Sheets("DOB").Cells(DOBRow, 24).Value 'salutation

'Create mail item and send it
Set MailItem = OutlookApp.createitem(olmailitem)
With MailItem
.Subject = Title 'email title
.to = EmailAddress 'parent email
.Body = "Dear " & ParentSalutation & vbCrLf & vbCrLf & TextBody 'body of text
If Attach <> "" Then
.Attachment.Add Attach 'attachment if there is one
End If
.Send
End With

EmailsSent = EmailsSent + 1 'increase count sent by one
'Report the number of emails sent
With Sheets("Pem")
.Range("L29").Value = EmailsSent 'number of emails sent
End With

Set MailItem = Nothing 'kill the Parent email object

EmailAddress = Sheets("DOB").Cells(DOBRow, 31).Value '2nd parent email address col 26
'Test if there is a second email address for this student
If EmailAddress <> "" Then

ParentSalutation = Sheets("DOB").Cells(DOBRow, 27).Value '2nd salutation
'Create mail item and send it
Set MailItem = OutlookApp.createitem(olmailitem)
With MailItem
.Subject = Title 'email title
.to = EmailAddress 'parent email
.Body = "Dear " & ParentSalutation & vbCrLf & vbCrLf & TextBody 'body of text
If Attach <> "" Then
.Attachments.Add Attach 'attachment if there is one
End If
.Send
End With

EmailsSent = EmailsSent + 1 'increase count sent by one
'Report the number of emails sent
With Sheets("Pem")
.Range("L29").Value = EmailsSent 'number of emails sent
End With
Set MailItem = Nothing 'kill the email object
End If
End If

With Sheets("Pem")
.Range("L28").Value = DOBRow - 5 'number of students scanned
End With

Next DOBRow

'ALL SENT emails message
Sheets("Pem").Range("j30").Value = "Done on " & Date & " at " & Time
Sheets("Pem").Range("j30").Select
End Sub

 

[Ceduljko]

Microsoft does not encourage using Office applications for those kind of tasks. Try to use CDO library for this.

Nice example is given at:
http://www.rondebruin.nl/cdo.htm

 

[MR Campbell]

Thanks for your reply.

I know how to use CDO but where this routine is intended to run, the network administrator says that the firewall will block CDO emails from being sent .... hence why I am resorting to Outlook automation.

My central question is ...... Does it make any difference whether Outlook is running when this method of automation is being attempted ?

 

[Ceduljko]

If Outlook is already running, it will be re-used. If not, it will load the default profile if not otherwise instructed.

 

[MR Campbell]

Does my code already assume that Outlook is running ... or does it start Outlook if it is not ?

 

[Ceduljko]

It starts it up if it's not running.

You can watch this by single-stepping through the code and having Task Manager / Processes on your screen. At a certain moment in time, you'll see a process called Outlook.exe appearing in the list, even if the application is not visible.

 

[MR Campbell]

Thanks for that ... so you can't see any fault with my code ?

Another strange thing is after the programme 'hangs', Outlook disappears and then when you double-click its icon to start it again, it refuses to open !! Very strange !

Only when you re-start your computer does outlook open again !
I am really puzzled !

Would appreciate any further help !

 

[Ceduljko]

I think that you do not have to restart your computer - just look again at the process list - Outlook is probably up'n'running and therefore 'it refuses' to start again.

Another trick is to set your Outlook application .visible property to True.

 

[MR Campbell]

Yes .. there were multiple Outlook processes running ... but what may have caused this to happen ... did my macro cause this ?

What line of code do I insert to make Outlook visible ... (although I don't know why you would want to make it visible if you are doing a bulk email send )

Again ... I appreciate your help.

 

[Ceduljko]

Troubleshooting purposes. Of course, you do not need the visible application in production mode.

OutlookApp.Visible = true

And... than I checked it in the object browser... and there was no .Visible property!

So, I have to take it back.

Without the access to the system and single stepping through the code, I can't think of why would it stop in the middle of the processing.