View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
losttoon losttoon is offline
external usenet poster
 
Posts: 2
Default Joining 2 modules as 1 for email with Excel

Hi, just like my nick I am lost. I need help with Excel in joining 2
modules as 1 for sending out 2 types of email templates to the
recipients. Can anyone help me? I have insert in the 2 modules that I
would like to form as 1.

Ron de Bruin, you would be finding the module familiar as I had almost
copied it all off from your website :) Thanks for the help you had
rendered in the past by sharing with us useful modules in your Excel
website. I really like your work alot. Keep it up

(Module 1)
Sub TestFile_2()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

On Error GoTo cleanup
For Each cell In Sheets("Sheet1").Columns("C").Cells.SpecialCells
(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0,
1).Value) = "reject" _
And LCase(cell.Offset(0, 2).Value) < "send" Then
Set OutMail = OutApp.CreateItem(olMailItem)

On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Thank You"
.Body = "Dear " & cell.Offset(0, -1).Value & vbNewLine
& vbNewLine & _
"I am sorry you are not liable to resit for
your exam."
"Yours Sincerely," & vbNewLine & vbNewLine &
_
"School Administrator"
.Send 'Or use Display
End With

On Error GoTo 0

cell.Offset(0, 2).Value = "send"
Set OutMail = Nothing
End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

(Module 2)

Sub testfile_3()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim cell As Range


Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

On Error GoTo cleanup
For Each cell In Sheets("Sheet1").Columns
("C").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0,
4).Value) = "Pending"
And LCase(cell.Offset(0, 5).Value) < "send" Then
Set OutMail = OutApp.CreateItem(olMailItem)

On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Thank You"
.Body = "Dear " & cell.Offset(0, -1).Value & vbNewLine
& vbNewLine & _
"Your application is currently being
reconsidered." & cell.Offset(0, 1).Value & _
"Kindly refer to the blackboard on 31 January
for the result outcome." & vbNewLine & vbNewLine & _
"Yours Sincerely," & vbNewLine & vbNewLine & _
"School Administrator"
.Send 'Or use Display
End With

On Error GoTo 0

cell.Offset(0, 5).Value = "send"
Set OutMail = Nothing
End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True

End Sub