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
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