Problem writing Outlook data to Access table

R

rangoonpost

I have been able to affect outlook and pull information from outlook and
display it via MSGBOX and now a form. But it does not write the data to the
table I created for it. I tried many ways to get and write the data, but
nothing shows up in the table. What is wrong??

Private Sub cmdSaveNewRecords_Click()

Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objDummy As Outlook.MailItem
Dim objRecip As Outlook.Recipient
Dim objAppt As Outlook.AppointmentItem
Dim strMsg As String
Dim strName As String

'Dim rst As DAO.Recordset
'Dim db As DAO.Database
Dim rst As Recordset
Dim db As Database

On Error Resume Next

Set db = CurrentDb
'MsgBox "db: " & db.Name

Set rst = db.OpenRecordset(Employee_Out, dbOpenDynaset)
'rst.MoveLast

' ### name of person whose Calendar you want to use ###
'strName = "Contractors Out"
strName = "^IC Help Desk"

Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objDummy = objApp.CreateItem(olMailItem)
Set objRecip = objDummy.Recipients.Add(strName)
objRecip.Resolve
If objRecip.Resolved Then
On Error Resume Next
Set objFolder = _
objNS.GetSharedDefaultFolder(objRecip, _
olFolderCalendar)

If Not objFolder Is Nothing Then
'Set objAppt = objFolder.Items.Add
For Each objAppt In objFolder.Items
If InStr(1, objAppt.SUBJECT, "OUT", vbTextCompare) > 0 Then

'MsgBox (objAppt.SUBJECT + " : " + Format(objAppt.START,
"mm/dd/yy hh:mm") + " to " + Format(objAppt.END, "mm/dd/yy hh:mm"))
Me.SUBJECT = objAppt.SUBJECT
Me.START = objAppt.START
Me.END = objAppt.END
Me.ALLDAY = objAppt.AllDayEvent

'NOTE: THE PROBLEM MAY BE HERE SOMEWHERE--------------------------

rst.AddNew
rst!SUBJECT = Me.SUBJECT
rst!START = Me.START
rst!END = Me.END
rst!ALLDAY = Me.ALLDAY
rst.Update

'MsgBox (Me.SUBJECT + " : " + Format(Me.START, "mm/dd/yy
hh:mm") + " to " + Format(Me.END, "mm/dd/yy hh:mm"))

End If

Next objAppt
End If
Else
MsgBox "Could not find " & Chr(34) & strName & Chr(34), , _
"User not found"
End If

rst.Close
Set rst = Nothing
db.Close
Set db = Nothing

Set objApp = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Set objDummy = Nothing
Set objRecip = Nothing
Set objAppt = Nothing

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top