Will Access generate an Outlook task from a date field?

[Mjbtrfly3]

I would like to use Access to track appointment scheduling and need to know if and how a date field can be programmed to generate Outlook tasks and reminders. Can anyone help me?

Thanks!

 

[B827]

I have created contacts in Outlook from an Access table using the following code. I'll to see if I have anything else, I seem to remember being asked about calendars in the past.

Function AddOutLookContacts()
Dim dbs As Database, Fred As Variant, varreturn As Variant
Dim Rst As Recordset, RecCnt As Double, strMsg As String
Dim objFolder As Object, olns As Object, MyNewFolder As Object, myNameSpace As NameSpace, MyOldFolder As Object
Dim outObj As Outlook.Application
Dim outCont As Outlook.ContactItem

Set outObj = CreateObject("outlook.application&quot
Set outObj = CreateObject("Outlook.Application&quot
Set myNameSpace = outObj.GetNamespace("MAPI&quot
Set objFolder = myNameSpace.GetDefaultFolder(olFolderContacts)
On Error Resume Next
Set MyOldFolder = objFolder.Folders("ContactsSCL&quot
MyOldFolder.Delete
On Error GoTo 0 'Err_AddOutLookContacts
'Exit Function
Set MyNewFolder = objFolder.Folders.Add("ContactsSCL", olFolderContacts) 'Folder ("ContactsSCL&quot

' Set outCont = outObj.GetNamespace(olFolderContacts) ', olFolderContacts)
Set dbs = CurrentDb
Fred = LoadtblContacts()

Set Rst = dbs.OpenRecordset("tblContacts", dbOpenDynaset)
Rst.MoveLast
RecCnt = Rst.RecordCount
Rst.MoveFirst
strMsg = "Copying Data to Outlook"
'AddAdjustment "target As String", 0
varreturn = SysCmd(acSysCmdInitMeter, strMsg, RecCnt) 'This puts a progress bar in place
RecCnt = 0

Do Until Rst.EOF
RecCnt = RecCnt + 1
varreturn = SysCmd(acSysCmdUpdateMeter, RecCnt) 'This moves the meter in the progress bar
' Set outCont = outObj.CreateItem(olContactItem)
Set outCont = MyNewFolder.Items.Add(olContactItem)
' Display the Fullname field for the contact
If Not IsNull(Rst!BusinessTelephoneNumber) Then
outCont.BusinessTelephoneNumber = Rst!BusinessTelephoneNumber
End If
If Not IsNull(Rst!FileAs) Then outCont.FileAs = Rst!FileAs
If Not IsNull(Rst!PagerNumber) Then outCont.PagerNumber = Rst!PagerNumber
If Not IsNull(Rst!BusinessFaxNumber) Then outCont.BusinessFaxNumber = Rst!BusinessFaxNumber
If Not IsNull(Rst!FirstName) Then outCont.FirstName = Rst!FirstName
If Not IsNull(Rst!LastName) Then outCont.LastName = Rst!LastName
If Not IsNull(Rst!Title) Then outCont.Title = Rst!Title
If Not IsNull(Rst!JobTitle) Then outCont.JobTitle = Rst!JobTitle
If Not IsNull(Rst!BusinessAddress) Then outCont.BusinessAddress = Rst!BusinessAddress
If Not IsNull(Rst!HomeAddress) Then outCont.HomeAddress = Rst!HomeAddress
If Not IsNull(Rst!Department) Then outCont.Department = Rst!Department
If Not IsNull(Rst!Profession) Then outCont.Profession = Rst!Profession
If Not IsNull(Rst!NickName) Then outCont.NickName = Rst!NickName
If Not IsNull(Rst!ManagerName) Then outCont.ManagerName = Rst!ManagerName
If Not IsNull(Rst!OtherAddress) Then outCont.OtherAddress = Rst!OtherAddress
If Not IsNull(Rst!FileAs) Then outCont.FileAs = Rst!FileAs
If Not IsNull(Rst!Suffix) Then outCont.Suffix = Rst!Suffix
If Not IsNull(Rst!Spouse) Then outCont.Spouse = Rst!Spouse
If Not IsNull(Rst!MiddleName) Then outCont.MiddleName = Rst!MiddleName
If Not IsNull(Rst!Initials) Then outCont.Initials = Rst!Initials
If Not IsNull(Rst!Company) Then outCont.CompanyName = Rst!Company
If Rst!Children = 0 Or IsNull(Rst!Children) Then
outCont.Children = ""
Else
outCont.Children = Rst!Children
End If
If Not IsNull(Rst!Categories) Then outCont.Categories = Rst!Categories
If Not IsNull(Rst!Gender) Then outCont.Gender = Rst!Gender
If Not IsNull(Rst!Business2TelephoneNumber) Then outCont.Business2TelephoneNumber = Rst!Business2TelephoneNumber
If Not IsNull(Rst!CarTelephoneNumber) Then outCont.CarTelephoneNumber = Rst!CarTelephoneNumber
If Not IsNull(Rst!HomeTelephoneNumber) Then outCont.HomeTelephoneNumber = Rst!HomeTelephoneNumber
If Not IsNull(Rst!Home2TelephoneNumber) Then outCont.Home2TelephoneNumber = Rst!Home2TelephoneNumber
If Not IsNull(Rst!MobileTelephoneNumber) Then outCont.MobileTelephoneNumber = Rst!MobileTelephoneNumber
If Not IsNull(Rst!CompanyMainTelephoneNumber) Then outCont.CompanyMainTelephoneNumber = Rst!CompanyMainTelephoneNumber
If Not IsNull(Rst!EMail1Address) Then outCont.EMail1Address = Rst!EMail1Address
If Not IsNull(Rst!CompanyMainTelephoneNumber) Then outCont.CompanyMainTelephoneNumber = Rst!CompanyMainTelephoneNumber
outCont.Save
' MsgBox .companymainphone


' .Update
Rst.MoveNext
Loop
varreturn = SysCmd(acSysCmdRemoveMeter)

Rst.Close
Exit_AddOutLookContacts:
Exit Function

Err_AddOutLookContacts:
MsgBox Err.Description, vbCritical + vbOKOnly, "Loading !! File Error"
Resume Exit_AddOutLookContacts
End Function

Sandy

 

[B827]

I knew I'd done something - I have done the reverse I have brought Appointments from Outlook to Access this might help.

Function GetOutlookAppointments()
Dim ol As Object
Dim olns As Object
Dim objFolder As Object
Dim objAllContacts As Object
Dim Appointment As Object
Dim appointments As Object
Dim dbs As Database, Rst As Recordset, fergusofardrossan As Date
Set dbs = CurrentDb
Set Rst = dbs.OpenRecordset("Timebooking", dbOpenDynaset)
' Set the application object
Set ol = New Outlook.Application
' Set the namespace object
Set olns = ol.GetNamespace("MAPI&quot
' Set the default Contacts folder
Set objFolder = olns.GetDefaultFolder(9)
' Set objAllContacts = the collection of all contacts
Set objAllContacts = objFolder.Items
' Loop through each contact
With Rst
For Each Appointment In objAllContacts
' Display the Fullname field for the contact
fergusofardrossan = Appointment.Start
If DatePart("yyyy", fergusofardrossan) = 2000 Then
fergusofardrossan = Appointment.End
End If

If Appointment.Start > Forms!frmtimebooking!STDate And Appointment.Start < Forms!frmtimebooking!EnDate Then
.AddNew
!Start = Appointment.Start
!Finish = Appointment.End
!Duration = Appointment.Duration
If IsNull(Appointment.Subject) Or Appointment.Subject = &quot;&quot; Then
!Subject = &quot;N/A&quot;
Else
!Subject = Appointment.Subject
End If
If IsNull(Appointment.Location) Or Appointment.Location = &quot;&quot; Then
!Location = &quot;N/A&quot;
Else
!Location = Appointment.Location
End If
If IsNull(Appointment.Body) Or Appointment.Body = &quot;&quot; Then
!Body = &quot;N/A&quot;
Else
!Body = Appointment.Body
End If
.Update
End If
Next
.Close
End With
End Function
Sandy

 

[Mjbtrfly3]

Sandy - wow, thank you for the information.

much appreciated,
Marilyn

 

[B827]

Marilyn
hope it helps solve the problem Sandy