Outlook 2007 All Day Event

Status
Not open for further replies.

LMS

Senior Member
Outlook version
Email Account
Exchange Server
The following code creates a calendar event based on the days and times from contact fields of the contact that is selected....but what I need to do, is I created the Subject using the words Birthday and Full Name, which shows up on the Calender Event,but what I want is that it is the day of of the event but as an "All Day Event", and if possible, it automatically in ever year going forward.

So here is the code and would be great to hear back right away:
Sub Create_Birthday_Calendar_Event_Full_Day3()
Dim objApp As Application
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim objMsg As mailItem
Dim ObjItem As Object
Dim objItems As Object
Dim remoteObj
Dim strDynamicDL As String
Dim ContactName
Dim olns
Dim myFolder
Dim NumItems
Dim myItem
Dim StartDateTime
Dim EndDateTime
Dim ShowAs
Dim itmAppt

Set oContact = ObjItem
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objSelection = objApp.ActiveExplorer.Selection

For Each ObjItem In objSelection

If ObjItem.Class = olContact Then

strDynamicDL = strDynamicDL & ";" & ObjItem.fullname
Else
strDynamicDL = strDynamicDL & ";" & obj.DLName

End If
Next
ContactName = strDynamicDL

Set myFolder = Session.GetDefaultFolder(9).Folders(2)
Set itmAppt = myFolder.Items.Add("IPM.Appointment.Office Calendar Event")
itmAppt.Subject = ContactName & (": ") & ("Birthday")

For Each ObjItem In objSelection
If ObjItem.Class = olContact Then
itmAppt.Location = ("Birthday")
StartDateTime = ObjItem.GetInspector.ModifiedFormPages("General").Controls("OlkDateControl1").value & " " & ObjItem.GetInspector.ModifiedFormPages("General").Controls("OlkTimeControl1").Text

itmAppt.Start = StartDateTime
EndDateTime = ObjItem.GetInspector.ModifiedFormPages("General").Controls("OlkDateControl2").value & " " & ObjItem.GetInspector.ModifiedFormPages("General").Controls("OlkTimeControl2").Text

itmAppt.End = EndDateTime
ShowAs = ObjItem.GetInspector.ModifiedFormPages("General").Controls("combobox13").value

Select Case ShowAs
Case "Free"
ShowAs = 0
Case "Tentative"
ShowAs = 1
Case "Busy"
ShowAs = 2
Case "Out of Office"
ShowAs = 3
End Select
itmAppt.BusyStatus = ShowAs

itmAppt.Links.Add ObjItem

End If
Next

itmAppt.Display

Set objMsg = Nothing
Set ObjItem = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Sub
 

LMS

Senior Member
Outlook version
Email Account
Exchange Server
So replace the following and add the other code at the top?

EndDateTime = ObjItem.GetInspector.ModifiedFormPages("General").Controls("OlkDateControl2").value & " " & ObjItem.GetInspector.ModifiedFormPages("General").Controls("OlkTimeControl2").Text

itmAppt.End = EndDateTime
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
This is the minimum you need to add:

Code:
Dim myPatternAs RecurrencePattern 
 
Set myPattern= oAppt.GetRecurrencePattern 
 
With itmAppt 
      .AllDayEvent = True 
     .Subject = ContactName & (": ") & ("Birthday") 
End With 
 
With myPattern 
    .RecurrenceType = olRecursYearly 
  ' .Occurrences = 20 'needed only if you want to set an end date 
   .PatternStartDate = birthdate-field 
   .StartTime = #12:00:00 AM# 
   .Duration = 1440 
End With 
 
itmAppt.Save 
itmAppt.Display
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
So replace the following and add the other code at the top?

EndDateTime = ObjItem.GetInspector.ModifiedFormPages("General").Controls("OlkDateControl2").value & " " & ObjItem.GetInspector.ModifiedFormPages("General").Controls("OlkTimeControl2").Text

itmAppt.End = EndDateTime

I'd replace both with the pattern code in my last message and use whatever field holds the birthdate where birthdate-field is.
 

LMS

Senior Member
Outlook version
Email Account
Exchange Server
Thanks but don't understand the full code. Can you please post the full code I should try? Thank you much
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Delete these two lines:
EndDateTime = ObjItem.GetInspector.ModifiedFormPages("General").Controls("OlkDateControl2").value & " " & ObjItem.GetInspector.ModifiedFormPages("General").Controls("OlkTimeControl2").Text
itmAppt.End = EndDateTime

replace with this:

Code:
 Dim myPattern As RecurrencePattern 
 Set myPattern = itmAppt.GetRecurrencePattern 
 
With  myPattern 
 .RecurrenceType = olRecursYearly 
' .Occurrences = 20 
 .PatternStartDate = itmAppt.Start 
 .StartTime = #12:00:00 AM# 
End With
 

LMS

Senior Member
Outlook version
Email Account
Exchange Server
Based on what you gave me, here is what I did, and it creates an all day event calendar event and it is also shows up every year...but, the date of the event is today......the field I have in my contact form.....the display of it is ComboBox30 and the field is comes with I created is name Birthday Date.....so how does this code change or what to add and where, so it creates it as the date of the field?

Sub Create_Birthday_Calendar_Event_Full_Day3()
Dim objApp As Application
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim objMsg As mailItem
Dim ObjItem As Object
Dim objItems As Object
Dim remoteObj
Dim strDynamicDL As String
Dim ContactName
Dim olns
Dim myFolder
Dim NumItems
Dim myItem
Dim StartDateTime
Dim EndDateTime
Dim ShowAs
Dim itmAppt
Dim myPattern As RecurrencePattern

Set oContact = ObjItem
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objSelection = objApp.ActiveExplorer.Selection

For Each ObjItem In objSelection

If ObjItem.Class = olContact Then

strDynamicDL = strDynamicDL & ";" & ObjItem.FullName
Else
strDynamicDL = strDynamicDL & ";" & obj.DLName

End If
Next

ContactName = strDynamicDL

Set myFolder = Session.GetDefaultFolder(9).Folders(2)
Set itmAppt = myFolder.Items.Add("IPM.Appointment.Office Calendar Event")
itmAppt.Subject = ContactName & (": ") & ("Birthday")

For Each ObjItem In objSelection

With itmAppt
.AllDayEvent = True
.Subject = ContactName & (": ") & ("Birthday")
End With

Set myPattern = itmAppt.GetRecurrencePattern

With myPattern
.RecurrenceType = olRecursYearly


End With

itmAppt.Save
itmAppt.Display


Select Case ShowAs
Case "Free"
ShowAs = 0
Case "Tentative"
ShowAs = 1
Case "Busy"
ShowAs = 2
Case "Out of Office"
ShowAs = 3
End Select

itmAppt.BusyStatus = ShowAs

itmAppt.Links.Add ObjItem

'End If
Next

itmAppt.Display

Set objMsg = Nothing
Set ObjItem = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Sub
 

LMS

Senior Member
Outlook version
Email Account
Exchange Server
I changed it one more time and here it is, and it uses the date from the contact field.....so this now works but, the begining of the subject before the name, there is a ; so how do we not have that show up?

Sub Create_Birthday_Calendar_Event_Full_Day3()
Dim objApp As Application
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim objMsg As mailItem
Dim ObjItem As Object
Dim objItems As Object
Dim remoteObj
Dim strDynamicDL As String
Dim ContactName
Dim olns
Dim myFolder
Dim NumItems
Dim myItem
Dim StartDateTime
Dim EndDateTime
Dim ShowAs
Dim itmAppt
Dim myPattern As RecurrencePattern

Set oContact = ObjItem
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objSelection = objApp.ActiveExplorer.Selection

For Each ObjItem In objSelection

If ObjItem.Class = olContact Then

strDynamicDL = strDynamicDL & ";" & ObjItem.FullName
Else
strDynamicDL = strDynamicDL & ";" & obj.DLName

End If
Next

ContactName = strDynamicDL

Set myFolder = Session.GetDefaultFolder(9).Folders(2)
Set itmAppt = myFolder.Items.Add("IPM.Appointment.Office Calendar Event")
itmAppt.Subject = ContactName & (": ") & ("Birthday")

For Each ObjItem In objSelection

With itmAppt
.AllDayEvent = True
.Subject = ContactName & (": ") & ("Birthday")
StartDateTime = ObjItem.GetInspector.ModifiedFormPages("General").Controls("ComboBox30")

itmAppt.Start = StartDateTime
End With

Set myPattern = itmAppt.GetRecurrencePattern

With myPattern
.RecurrenceType = olRecursYearly


End With

itmAppt.Save
itmAppt.Display


Select Case ShowAs
Case "Free"
ShowAs = 0
Case "Tentative"
ShowAs = 1
Case "Busy"
ShowAs = 2
Case "Out of Office"
ShowAs = 3
End Select

itmAppt.BusyStatus = ShowAs

itmAppt.Links.Add ObjItem
Next

itmAppt.Display

Set objMsg = Nothing
Set ObjItem = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Sub
 

Forum Admin

Senior Member
The ; would be coming from the ContactName field you are using. Looks like it's constructed from the strDynamicDL
 

LMS

Senior Member
Outlook version
Email Account
Exchange Server
In my contact field there is no ; so is there a way to fix this code so the ; is not in front of the Subject? Thanks.
 

LMS

Senior Member
Outlook version
Email Account
Exchange Server
I changed 'strDynamicDL = strDynamicDL & ";" & ObjItem.fullname to strDynamicDL = ObjItem.fullname and it did it
 

LMS

Senior Member
Outlook version
Email Account
Exchange Server
Next question re this same code. As you showed me the same process in a different code.

This works when I select or open a contact....but if the contact is opened from the email I received, the code does not work.

In the past you added something to my code for converting things between fields when I open the contact from the email I received.....so I don't know what to add to this, so when I open a contact from the email I receive, the code works for that opened contact. Thanks much.
 

LMS

Senior Member
Outlook version
Email Account
Exchange Server
Next question re this same code. As you showed me the same process in a different code.

This works when I select or open a contact....but if the contact is opened from the email I received, the code does not work.

In the past you added something to my code for converting things between fields when I open the contact from the email I received.....so I don't know what to add to this, so when I open a contact from the email I receive, the code works for that opened contact. Thanks much.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
You mean when you double click on an address in an email and the contact opens? Didn't you figure out the code to do that a few weeks ago?
 

LMS

Senior Member
Outlook version
Email Account
Exchange Server
You gave it for a code i was using but don't know exactly what to add to this code creating the birthday all day calendar event. Can you post what I need and where to put it please?
 

LMS

Senior Member
Outlook version
Email Account
Exchange Server
Any update as to what to put into this code and where?
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
H Conflicts with other event in calendar ( outlook 2007 & 2010) Using Outlook 0
R outlook 2007 itemadd event handler fails to run Outlook VBA and Custom Forms 2
C Outlook 2007 Removing then adding account restores junk email processing Using Outlook 0
S Outlook 2007 crash linked to gdiplus.dll Using Outlook 0
S Outlook 2007 - Automatic purge fail Using Outlook 0
J outlook 2007 doesn't let me choose which .pst to search Using Outlook 2
D Outlook 2007 vs. Outlook 2010 -- ToDo Bar Using Outlook 0
D Outlook 2007 on 365 Using Outlook.com accounts in Outlook 2
S Macro for other actions - Outlook 2007 Outlook VBA and Custom Forms 23
S Verwendung von Outlook 2007 Using Outlook 0
A Arthur needs help with 2007 Outlook e-mail Using Outlook.com accounts in Outlook 3
M PST import from Outlook 2007 to 2010 - Address Book contacts all in 1 group Using Outlook 4
S outlook 2007 calendar search Using Outlook 6
B Migrate Outlook 2007 to Office 365 Using Outlook 3
X I have met my waterloo trying to resolve embedded graphics problem with outlook 2007 and now 2016 Using Outlook 1
R Outlook 2007 only loads some appointments Using Outlook 0
C Move Outlook 2007 to new PC with Outlook 365 Using Outlook 3
J Outlook 2007 Hide Messages Option not Available Using Outlook 2
S Outlook 2007 Calendar instant search problem. Windows 7 Using Outlook 4
S Outlook 2007 Calendar instant search problem. Windows 7 Using Outlook 0
B Server errors Outlook 2007 Using Outlook 1
S Reboot of frozen windows7 results in changed outlook 2007 settings Using Outlook 1
S Outlook 2007 printing wrong email address at top of page Using Outlook 8
M Configure outlook 2007 to accept digital signatures Using Outlook 2
D Outlook 2007 crashes when opening an email Using Outlook 2
R New chap saying hello and needing advice on Outlook 2007 thumbnails Using Outlook 3
icacream From Outlook 2007 to 2016 ! Using Outlook 9
vodkasoda Object could not be found Error in Outlook 2007 Outlook VBA and Custom Forms 5
S Outlook 2007: Address Cards allow entering text! Why? Using Outlook 3
S View Appointment in Text Wrap in Outlook 2007 Month Calendar View Using Outlook 0
L Outlook 2007 Separate the Send/Receive functions Using Outlook 2
M Outlook 2007 Contacts Glitch: Creating a new email Using Outlook 1
C Move from Outlook 2007 Enterprise (MOE) to Outlook Pro plus 2007 Using Outlook 1
J reinstalling Outlook 2007 asking for user name & password Using Outlook 14
P outlook addin unloaded in office 2007 Using Outlook 0
B Fonts in Outlook 2007 Using Outlook 4
R Add Exchange Account to existing POP3 Outlook 2007 Profile Using Outlook 0
C out of space in file group Outlook 2007 Using Outlook 2
A Moving archived contents in Outlook 2007 back into working folders Using Outlook 0
P Outlook 2007 Email Categorization using VBA Outlook VBA and Custom Forms 1
M Unable to Configure Gmail Account in Outlook 2007 Using Outlook 1
R Outlook 2007 or 2010 - Lock Down Functionality Outlook VBA and Custom Forms 3
S Outlook 2007, windows 10 Font size Using Outlook 1
Diane Poremsky Manually create a POP3 account in Outlook 2007 Using Outlook 0
J Can Click to Drag Custom Form Field But Cannot Drop When Designing in Outlook 2007 Outlook VBA and Custom Forms 2
L Outlook 2007 Font Using Outlook 3
J Outlook 2007 connector and Windows 10 Using Outlook 3
R Outlook 2007 - Shared Accounts and Resources without Exchange Server Using Outlook 0
L Outlook 2007 - Macro Re Search Using Outlook 16
D Outlook (Office) 2007 & Windows 10 Pro Using Outlook 6

Similar threads

Top