OrbitMascot
Programmer
I have been working in Access 97 (I know its historic, but that is the version the company is using) trying to take information from Access and place it in a calendar located in a public folder in Outlook. The problem that I am having is that Access 97 does not recognize some of the commands that are in the code. The commands REPLACE and SPLIT are not recognizable in Access 97. If anyone has any information on how to recode or change the code to make it work in Access 97 I would greatly appreciative. Attached below is the code for anyone to review. Thanks for all your help.
Public Function GetFolder(strFolderPath As String) As MAPIFolder
' folder path needs to be something like
' "Public Folders\All Public Folders\SJIM\Vacation Calendar"
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders() As String
Dim I As Long
On Error Resume Next
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.Folders.Item(arrFolders(0))
If Not objFolder Is Nothing Then
For I = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(I))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Function
Private Sub SendTask_Click()
Dim golApp As Outlook.Application
Dim fldFolder As MAPIFolder
Dim strPublicFolder As String
Dim obj As AppointmentItem
Set golApp = New Outlook.Application
strPublicFolder = "Public Folders\All Public Folders\South Campus\Request Calendar"
Set fldFolder = GetFolder(strPublicFolder)
Set obj = fldFolder.Items.Add(olAppointmentItem)
With obj
.Start = Now()
.Subject = "Test Appointment"
.Location = "Cafeteria"
.Save
End With
End Sub
Public Function GetFolder(strFolderPath As String) As MAPIFolder
' folder path needs to be something like
' "Public Folders\All Public Folders\SJIM\Vacation Calendar"
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders() As String
Dim I As Long
On Error Resume Next
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.Folders.Item(arrFolders(0))
If Not objFolder Is Nothing Then
For I = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(I))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Function
Private Sub SendTask_Click()
Dim golApp As Outlook.Application
Dim fldFolder As MAPIFolder
Dim strPublicFolder As String
Dim obj As AppointmentItem
Set golApp = New Outlook.Application
strPublicFolder = "Public Folders\All Public Folders\South Campus\Request Calendar"
Set fldFolder = GetFolder(strPublicFolder)
Set obj = fldFolder.Items.Add(olAppointmentItem)
With obj
.Start = Now()
.Subject = "Test Appointment"
.Location = "Cafeteria"
.Save
End With
End Sub