ник: ????????
Re: Работа с календарём MS Outlook Я то же статью не помню, но у себя делаю так.
Option Compare Database
Option Explicit
Private myolApp As Outlook.Application
Private myNamespace As Outlook.Namespace
Private myFolderTasks As Outlook.Items
Private myMAPIFolderTasks As Outlook.MAPIFolder
Private myItem As Object
Private blnFlag As Boolean
Private Sub Form_Close()
Set myFolderTasks = Nothing
Set myNamespace = Nothing
Set myolApp = Nothing
End Sub
Private Sub cmdClose_Click()
DoCmd.Close
End Sub
Private Sub Form_Open(Cancel As Integer)
Set myolApp = CreateObject("Outlook.Application")
If Me.OpenArgs <> "" Then
Set myNamespace = myolApp.GetNamespace("MAPI")
Set myFolderTasks = myNamespace.GetDefaultFolder(olFolderTasks).Items
For Each myItem In myFolderTasks
If (myItem.Class = olTask) Then
If StrComp(myItem.EntryID, Me.OpenArgs) = 0 Then Exit For
End If
Next
With myItem
On Error Resume Next
txtMessage = .Body
If Err.Number <> 0 Then Cancel = True: Err.Clear: On Error GoTo 0: Exit Sub
txtHeader = .Subject
txtDate = FormatDateTime(.ReminderTime, 2)
txtTime = FormatDateTime(.ReminderTime, 4)
End With
End If
End Sub
Private Sub cmdSave_Click()
Если форму открыли не для редакции
If Nz(Me.OpenArgs, "") = "" Then Set myItem = myolApp.CreateItem(olTaskItem)
With myItem
.Subject = txtHeader
.Body = txtMessage
.ReminderSet = True
.ReminderPlaySound = True
.ReminderSoundFile = "C:WindowsMediaDing.wav"
.ReminderTime = DateValue(txtDate) + TimeValue(txtTime)
.Save
End With
On Error Resume Next
Forms("frm_sys_MagazineReminder").Fill
End Sub