Joining 2 modules as 1 for email with Excel

[losttoon]

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

 

[losttoon]

I don't understand why you want to join the 2 modules?, if you mean RUN
the 2 modules you simply CALL the next module before the end of your
first code, so the very last bit of your first code would look like
this:

Code:
--------------------
    Application.ScreenUpdating = True
  Call testfile_3
  End Sub
--------------------

losttoon;183153 Wrote:> Hi, just like my nick I am lost. I need help withExcel in joining 2


Code:
--------------------
  >   >  
  > (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
  >
--------------------



--
Simon Lloyd

Regards,
Simon Lloyd
'The Code Cage' (http://www.thecodecage.com)

Dear Simon,

I had tried but there was no reaction when i tried to run the module.
Both modules are in the same excel file and i am trying to make the
system understand that when i key in reject, it will auto generate a
rejection letter to the applicant and if i enter KIV, it will auto
generate another KIV letter to the applicant.
I hope you will be able to assist in this as I have not much
experience in self creation of marco script and will need your support
in the script creation. Thanks for your help