Kevin99
Member
- OS Version(s)
- Windows
- Outlook version
- Outlook 365 32 bit
- Email Account
- Office 365 Exchange
Operating system:: Windows
Outlook version: MS365
Email type or host: Exchange
Outlook version: MS365
Email type or host: Exchange
It used to work that I could hit a command bar and it would do the following:
Sub cmdMakeAppt_Click()
Const olAppointmentItem = 1
Set objAppt = Application.CreateItem(olAppointmentItem)
If Item.Size = 0 Then
Item.Save ' must save item before adding link
End If
With objAppt
.Subject = "Follow-up call to " & Item.FullName
.Body = Item.Body
.Links.Add Item
End With
objAppt.Display
Set objAppt = Nothing
End Sub
Sub cmdFollowup_Click()
Const olAppointmentItem = 1
Set objAppt = Application.CreateItem(olAppointmentItem)
If Item.Size = 0 Then
Item.Save ' must save item before adding link
End If
With objAppt
.Subject = "Meeting with " & Item.FullName
.Body = Item.Body
.Links.Add Item
End With
objAppt.Display
Set objAppt = Nothing
End Sub
Sub cmdTodo_Click()
Const olTaskItem = 3
Set objTask = Application.CreateItem(olTaskItem)
If Item.Size = 0 Then
Item.Save ' must save item before adding link
End If
With objTask
.Subject = "Follow-Up with " & Item.FullName
.Body = Item.Body
.Links.Add Item
End With
objTask.Display
Set objTask = Nothing
End Sub
Sub commandtouch_Click()
Dim objNS
Set objNS = Application.GetNamespace("MAPI")
Item.Body = Item.Body & vbCrLf & Now() _
& " - " & objNS.CurrentUser
Set objNS = Nothing
End Sub
Sub cmdMakeAppt_Click()
Const olAppointmentItem = 1
Set objAppt = Application.CreateItem(olAppointmentItem)
If Item.Size = 0 Then
Item.Save ' must save item before adding link
End If
With objAppt
.Subject = "Follow-up call to " & Item.FullName
.Body = Item.Body
.Links.Add Item
End With
objAppt.Display
Set objAppt = Nothing
End Sub
Sub cmdFollowup_Click()
Const olAppointmentItem = 1
Set objAppt = Application.CreateItem(olAppointmentItem)
If Item.Size = 0 Then
Item.Save ' must save item before adding link
End If
With objAppt
.Subject = "Meeting with " & Item.FullName
.Body = Item.Body
.Links.Add Item
End With
objAppt.Display
Set objAppt = Nothing
End Sub
Sub cmdTodo_Click()
Const olTaskItem = 3
Set objTask = Application.CreateItem(olTaskItem)
If Item.Size = 0 Then
Item.Save ' must save item before adding link
End If
With objTask
.Subject = "Follow-Up with " & Item.FullName
.Body = Item.Body
.Links.Add Item
End With
objTask.Display
Set objTask = Nothing
End Sub
Sub commandtouch_Click()
Dim objNS
Set objNS = Application.GetNamespace("MAPI")
Item.Body = Item.Body & vbCrLf & Now() _
& " - " & objNS.CurrentUser
Set objNS = Nothing
End Sub