If AM run VBA, If PM run slightly different VBA

M

Marhier

Board Regular
Joined
Feb 21, 2017
Messages
128
Office Version
  1. 365
  2. 2021
Platform
  1. Windows
Good morning, I hope you're all well today.
I've been trying to find a solution, and various threads I check are all related to running VBA at specific times and intervals.

What I'm after is the following:

If the current time is AM, when I press the button the macro is assigned to, run the following code:

VBA Code: 
Sub OrderEmail()
If MsgBox("Have you selected a cell from the line of the schedule you'd like to order?", vbYesNo) = vbNo Then Exit Sub
Application.ScreenUpdating = False
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim sRng As Range
Set wsSheet = ActiveSheet
Set sRng = wsSheet.Range("Z3")
Set ProjectManagerEmail = wsSheet.Range("P4")
Set ProjectManagerEmail2 = wsSheet.Range("P5")
Set Sep = wsSheet.Range("AA1")

Call UnProtect

ActiveSheet.Cells(ActiveCell.Row, 15).Select
Range("Y3").Value = ActiveCell
ActiveSheet.Cells(ActiveCell.Row, 13).Select
Range("Y4").Value = ActiveCell
ActiveSheet.Cells(ActiveCell.Row, 7).Select
Range("Y5").Value = ActiveCell

Call Protect

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = "Good morning. <br>" & _
        "Please deliver as per the attached schedule(s)<br>" & _
        "Invoice to RR  Ltd.<br><br>" & _
        "When responding to this email, or sending an acknowledgement, can you please reply to this email, keeping the subject?<br><br>" & _
        "Much appreciated.<br>" & _
        "Thank you."

On Error Resume Next

With OutMail
    .Display
    .To = ""
    .CC = ProjectManagerEmail & Sep & ProjectManagerEmail2
    .BCC = ""
    .Subject = sRng
    .HTMLBody = strbody & .HTMLBody
End With

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
Exit Sub
End Sub

If the current time is PM, when I press the button the macro is assigned to, run the following code:

VBA Code: 
Sub OrderEmail()
If MsgBox("Have you selected a cell from the line of the schedule you'd like to order?", vbYesNo) = vbNo Then Exit Sub
Application.ScreenUpdating = False
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim sRng As Range
Set wsSheet = ActiveSheet
Set sRng = wsSheet.Range("Z3")
Set ProjectManagerEmail = wsSheet.Range("P4")
Set ProjectManagerEmail2 = wsSheet.Range("P5")
Set Sep = wsSheet.Range("AA1")

Call UnProtect

ActiveSheet.Cells(ActiveCell.Row, 15).Select
Range("Y3").Value = ActiveCell
ActiveSheet.Cells(ActiveCell.Row, 13).Select
Range("Y4").Value = ActiveCell
ActiveSheet.Cells(ActiveCell.Row, 7).Select
Range("Y5").Value = ActiveCell

Call Protect

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = "Good afternoon.<br>" & _
        "Please deliver as per the attached schedule(s)<br>" & _
        "Invoice to RR  Ltd.<br><br>" & _
        "When responding to this email, or sending an acknowledgement, can you please reply to this email, keeping the subject?<br><br>" & _
        "Much appreciated.<br>" & _
        "Thank you."

On Error Resume Next

With OutMail
    .Display
    .To = ""
    .CC = ProjectManagerEmail & Sep & ProjectManagerEmail2
    .BCC = ""
    .Subject = sRng
    .HTMLBody = strbody & .HTMLBody
End With

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
Exit Sub
End Sub

All help is greatly appreciated.

Thank you.
Regards.
Marhier.
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
Marhier said:
Good morning, I hope you're all well today.
I've been trying to find a solution, and various threads I check are all related to running VBA at specific times and intervals.

What I'm after is the following:

If the current time is AM, when I press the button the macro is assigned to, run the following code:

VBA Code: 
Sub OrderEmail()
If MsgBox("Have you selected a cell from the line of the schedule you'd like to order?", vbYesNo) = vbNo Then Exit Sub
Application.ScreenUpdating = False
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim sRng As Range
Set wsSheet = ActiveSheet
Set sRng = wsSheet.Range("Z3")
Set ProjectManagerEmail = wsSheet.Range("P4")
Set ProjectManagerEmail2 = wsSheet.Range("P5")
Set Sep = wsSheet.Range("AA1")

Call UnProtect

ActiveSheet.Cells(ActiveCell.Row, 15).Select
Range("Y3").Value = ActiveCell
ActiveSheet.Cells(ActiveCell.Row, 13).Select
Range("Y4").Value = ActiveCell
ActiveSheet.Cells(ActiveCell.Row, 7).Select
Range("Y5").Value = ActiveCell

Call Protect

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = "Good morning. <br>" & _
        "Please deliver as per the attached schedule(s)<br>" & _
        "Invoice to RR  Ltd.<br><br>" & _
        "When responding to this email, or sending an acknowledgement, can you please reply to this email, keeping the subject?<br><br>" & _
        "Much appreciated.<br>" & _
        "Thank you."

On Error Resume Next

With OutMail
    .Display
    .To = ""
    .CC = ProjectManagerEmail & Sep & ProjectManagerEmail2
    .BCC = ""
    .Subject = sRng
    .HTMLBody = strbody & .HTMLBody
End With

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
Exit Sub
End Sub

If the current time is PM, when I press the button the macro is assigned to, run the following code:

VBA Code: 
Sub OrderEmail()
If MsgBox("Have you selected a cell from the line of the schedule you'd like to order?", vbYesNo) = vbNo Then Exit Sub
Application.ScreenUpdating = False
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim sRng As Range
Set wsSheet = ActiveSheet
Set sRng = wsSheet.Range("Z3")
Set ProjectManagerEmail = wsSheet.Range("P4")
Set ProjectManagerEmail2 = wsSheet.Range("P5")
Set Sep = wsSheet.Range("AA1")

Call UnProtect

ActiveSheet.Cells(ActiveCell.Row, 15).Select
Range("Y3").Value = ActiveCell
ActiveSheet.Cells(ActiveCell.Row, 13).Select
Range("Y4").Value = ActiveCell
ActiveSheet.Cells(ActiveCell.Row, 7).Select
Range("Y5").Value = ActiveCell

Call Protect

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = "Good afternoon.<br>" & _
        "Please deliver as per the attached schedule(s)<br>" & _
        "Invoice to RR  Ltd.<br><br>" & _
        "When responding to this email, or sending an acknowledgement, can you please reply to this email, keeping the subject?<br><br>" & _
        "Much appreciated.<br>" & _
        "Thank you."

On Error Resume Next

With OutMail
    .Display
    .To = ""
    .CC = ProjectManagerEmail & Sep & ProjectManagerEmail2
    .BCC = ""
    .Subject = sRng
    .HTMLBody = strbody & .HTMLBody
End With

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
Exit Sub
End Sub

All help is greatly appreciated.

Thank you.
Regards.
Marhier.
Click to expand...
try attaching the below to your button. You can change the "12:00" to suit if you consider this to be AM or PM. Both your morning and afternoon codes have the same sub name so you will need to have different names.

VBA Code: 
If Time <= TimeValue("12:00") Then
     call 'name of your morning code
Else
     call 'name of your afternoon code
End If

if however the only difference is your "Good Morning / Good Afternoon" phrase then you could simply use one code and assign this to a variable by saying

VBA Code: 
If Time <= TimeValue("12:00") Then
     Greeting = "Good Morning"
Else
      Greeting = "Good Afternoon"
End If

then replace the strbody of your code with this

VBA Code: 
strbody = Greeting & ". <br>" & _
        "Please deliver as per the attached schedule(s)<br>" & _
        "Invoice to RR  Ltd.<br><br>" & _
        "When responding to this email, or sending an acknowledgement, can you please reply to this email, keeping the subject?<br><br>" & _
        "Much appreciated.<br>" & _
        "Thank you."
 
Upvote 0
Solution
Brilliant, that was just what I was after!
I used:

VBA Code: 
If Time <= TimeValue("12:00") Then
Greeting = "Good Morning"
Else
Greeting = "Good Afternoon"
End If

and then.

VBA Code: 
strbody = Greeting & ". <br>" & _
        "Please deliver as per the attached schedule(s)<br>" & _
        "Invoice to RR  Ltd.<br><br>" & _
        "When responding to this email, or sending an acknowledgement, can you please reply to this email, keeping the subject?<br><br>" & _
        "Much appreciated.<br>" & _
        "Thank you."

Thank you so much for your help.

Regards
Marhier.
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Solved
Dynamic Button for Email Macro
Replies
4
Views
204
GarnesGambit
G
A
  • Solved
Sending hyperlink filepath via email
Replies
8
Views
323
AndyEd
A
S
  • Question
VBA Code hangs on Outlook Send?
Replies
2
Views
353
shophoney
S
The Ruff Report
  • Question
Help adjusting Macro to email multiple cc addresses
Replies
1
Views
368
The Ruff Report
The Ruff Report
C
  • Solved
Adding an editable pop-up
Replies
3
Views
264
ChaosPup
C

Forum statistics

Threads
1,214,653
Messages
6,120,749
Members
448,989
Latest member
mariah3

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top