Solved

Excel VBA minus one month

Posted on 2010-08-22
3
630 Views
Last Modified: 2012-05-10
Hi Experts

I have this macro which adds a MS Outlook appointment based on the selected Excel Cell (which is a date).  It works OK.

As you will see, the following line sets the appointment start to be at 8am, 31 days before the ActiveCell date.  

        .Start = ActiveCell.Value - 31 + TimeValue("08:00:00")

My question is, how can I change that to be ONE MONTH before the ActiveCell date rather than 31 days?  That way, if the ActiveCell date is 24/3/2011, .Start will be 24/2/2011.

Thanks

Will

Sub Set_Outlook_Reminder()
Dim objOutlook As Object
Dim objAppt As Object
Dim objNamespace As Object
Dim objFolder As Object
 
Worksheets("Customer Database").Activate
 
    Set objOutlook = CreateObject("Outlook.Application")
    
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objFolder = objNamespace.GetDefaultFolder(9)
    Set objAppt = objFolder.Items.Add 'create task item
    With objAppt
        .Start = ActiveCell.Value - 31 + TimeValue("08:00:00")
        .End = .Start + TimeValue("00:30:00")
        .Subject = "Invoice " + ActiveCell.Offset(-2, 0).Value
        .Location = ""
        .Body = ""
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = 120
        .ReminderSet = True
        .Save
    End With

Set objAppt = Nothing
Set objFolder = Nothing
Set objNamespace = Nothing
Set objOutlook = Nothing

MsgBox "Successfully Added to Outlook"

End Sub

Open in new window

0
Comment
Question by:willnjen
  • 2
3 Comments
 
LVL 5

Accepted Solution

by:
ploftin earned 500 total points
ID: 33497232
To get the date of "one month ago", use this:
Sub Set_Outlook_Reminder()
Dim objOutlook As Object
Dim objAppt As Object
Dim objNamespace As Object
Dim objFolder As Object
 
Worksheets("Customer Database").Activate
 
    Set objOutlook = CreateObject("Outlook.Application")
    
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objFolder = objNamespace.GetDefaultFolder(9)
    Set objAppt = objFolder.Items.Add 'create task item
    With objAppt
        .Start = DateAdd("m",1,ActiveCell.Value) + TimeValue("08:00:00")
        .End = .Start + TimeValue("00:30:00")
        .Subject = "Invoice " + ActiveCell.Offset(-2, 0).Value
        .Location = ""
        .Body = ""
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = 120
        .ReminderSet = True
        .Save
    End With

Set objAppt = Nothing
Set objFolder = Nothing
Set objNamespace = Nothing
Set objOutlook = Nothing

MsgBox "Successfully Added to Outlook"

End Sub

Open in new window

0
 

Author Comment

by:willnjen
ID: 33497293
Perfect, except it added one month so i changed it to the following...

        .Start = DateAdd("m",-1,ActiveCell.Value) + TimeValue("08:00:00")

Thanks for your help!!!
0
 
LVL 5

Expert Comment

by:ploftin
ID: 33497374
Sorry about that. My math is off today lol. :)
0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

856 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question