moonchick said:
Can I add a calendar to a word doc that interacts with Outlook and
adds an appointment to an Outlook calendar?
The short answer is yes, but the programming is a little complicated for
reproduction in a newsgroup thread.
See
http://www.gmayor.com/popup_calendar.htm which shows how to create the
calendar, and insert the date from it in a Word document.
This uses the section
Private Sub Calendar1_Click()
With Selection
.Text = Format(Calendar1.Value, "dd mmmm yyyy")
.MoveRight Unit:=wdCharacter, Count:=1
End With
Unload Me
End Sub
to insert the date into a document, however, if you want to insert an
appointment on that date into Outlook you need to add some more code to that
section.
The basic code for creating an appointment would be as follows. The macro
prompts for an Outlook category and for the text associated with the
appointment. The appointment uses the document name as a subject and sets an
all day appointment. Add or change the options to suit your own requirements
Private Sub Calendar1_Click()
Dim ol As New Outlook.Application
Dim ci As AppointmentItem
Dim strDate As String
Dim strTime As String
Dim strDocName As String
Dim strExt As String
Dim intPos As Integer
Dim datOutlookDate As Date
With Selection ' this bit adds the date to the document
.Text = Format(Calendar1.Value, "dd mmmm yyyy")
.MoveRight Unit:=wdCharacter, Count:=1
End With
strDate = Calendar1.Value
strTime = Format((Time), "hh:mm")
datOutlookDate = CDate(strDate & " " & strTime)
If Application.version = 12 Then
sExt = ".docx"
strFileType = wdFormatXMLDocument
Else
sExt = ".doc"
strFileType = wdFormatDocument
End If
'Find position of extension in filename
With ActiveDocument
On Error GoTo CancelledByUser
If Len(.Path) = 0 Then
ActiveDocument.Save
End If
intPos = InStr(1, .Name, ".")
strDocName = Left(.Name, intPos - 1)
End With
Set ci = ol.CreateItem(olAppointmentItem)
ci.Start = strDate
ci.ReminderSet = False
ci.AllDayEvent = True
ci.Subject = strDocName
ci.Categories = InputBox("Category?")
ci.Body = InputBox("Body Text?")
ci.BusyStatus = olFree
ci.Save
Set ol = Nothing
Unload Me
Exit Sub
CancelledByUser: 'Error handler
MsgBox "Cancelled By User", , "Operation Cancelled"
End Sub
--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP
My web site
www.gmayor.com
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
