yesid821010
New Member
- Joined
- Feb 21, 2012
- Messages
- 4
Hi everybody,
I am trying to create appointments in a Calendar that I call German. I have tried everything no matter what I try:
1. Excel keeps creating the appointment in my default calendar.
2. I can't get it to last 4 minutes even though I have .duration = "00:04:00"
Below is the code, I don't know what I am doing wrong. Thank you in advance.
Sub CreateAppointment()
Dim oApp As Outlook.Application
Dim oNameSpace As Namespace
Dim oItem As AppointmentItem
On Error Resume Next
' check if Outlook is running
Set oApp = GetObject("Outlook.Application")
If Err <> 0 Then
'if not running, start it
Set oApp = CreateObject("Outlook.Application")
End If
Set oNameSpace = oApp.GetNamespace("MAPI").Session.GetDefaultFolder(olFolderCalendar).Folders("German")
lafile = 2
For combiendefois = 0 To lafile
Set oItem = oApp.CreateItem(olAppointmentItem)
With oItem
.Subject = Range("c" & lafile).Value
.Start = Range("a" & lafile).Value
.Duration = "00:04:00"
.Importance = olImportanceNormal
.ReminderSet = True
.ReminderMinutesBeforeStart = "0"
.ReminderPlaySound = False
.Save
End With
lafile = lafile + 1
Next
Set oApp = Nothing
Set oNameSpace = Nothing
Set oItem = Nothing
End Sub
I am trying to create appointments in a Calendar that I call German. I have tried everything no matter what I try:
1. Excel keeps creating the appointment in my default calendar.
2. I can't get it to last 4 minutes even though I have .duration = "00:04:00"
Below is the code, I don't know what I am doing wrong. Thank you in advance.
Sub CreateAppointment()
Dim oApp As Outlook.Application
Dim oNameSpace As Namespace
Dim oItem As AppointmentItem
On Error Resume Next
' check if Outlook is running
Set oApp = GetObject("Outlook.Application")
If Err <> 0 Then
'if not running, start it
Set oApp = CreateObject("Outlook.Application")
End If
Set oNameSpace = oApp.GetNamespace("MAPI").Session.GetDefaultFolder(olFolderCalendar).Folders("German")
lafile = 2
For combiendefois = 0 To lafile
Set oItem = oApp.CreateItem(olAppointmentItem)
With oItem
.Subject = Range("c" & lafile).Value
.Start = Range("a" & lafile).Value
.Duration = "00:04:00"
.Importance = olImportanceNormal
.ReminderSet = True
.ReminderMinutesBeforeStart = "0"
.ReminderPlaySound = False
.Save
End With
lafile = lafile + 1
Next
Set oApp = Nothing
Set oNameSpace = Nothing
Set oItem = Nothing
End Sub
Last edited: