MR Campbell
Board Regular
- Joined
- Aug 2, 2002
- Messages
- 113
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
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