Create an Outlook Folder
by
rickman
·
about 19 years, 5 months ago
In reply to Create a new folder from Access 2002
jenni,
I assume that you mean a an outlook folder, possibly you want to put the folder under the Sent Items folder as a new folder. Then when you direct e-mail from the access application you have set the sent folder to the new folder.
I hope that this code is helpful, and a disclaimer on the code is that you need to be running signed code, that is registered in Outlook to avoid the Outlook security messagebox.
Name space setup is important. to running this application and remember to reference the outlook dll in you application.
First create a routine to setup your e-mail
Public Function fSendMail(ByVal emrMailType As Integer, _
ByRef mItem As tCCItem, ByRef mAct As tActivity)
On Error GoTo Err_fSendMail
Dim objOutlook As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objSent As Outlook.MAPIFolder
Dim objOLMail As Outlook.MailItem
Dim objRcps As Outlook.Recipients
.
.
.
Set objOutlook = CreateObject(“Outlook.Application”)
Set objNS = objOutlook.GetNamespace(“MAPI”)
‘ Make sure that the User Has a folder called newfolder under the
‘ Sent Items Folder. All mail that is sent will be copied
‘ to that folder.
fChkFolder objNS ‘Verifies folder exists
‘ Set outlook information to use new folder
Set objOLMail = objOutlook.CreateItem(olMailItem)
Set objSent = objOutlook.Session.GetDefaultFolder(olFolderSentMail)
Set objOLMail.SaveSentMessageFolder = objSent.Folders(“newfoldername”)
‘Build message Body
.
.
.
Exit_fSendMail:
If Not objOutlook Is Nothing Then Set objOutlook = Nothing
If Not objOLMail Is Nothing Then Set objOLMail = Nothing
If Not objSent Is Nothing Then Set objSent = Nothing
If Not objRcps Is Nothing Then Set objRcps = Nothing
DoCmd.Hourglass False
Exit Function
Err_fSendMail:
MsgBox Str(Err.Number) & ” –> ” & Err.Description
Resume Exit_fSendMail
End Function
Private Function fChkFolder(ByRef objOutlook As Outlook.NameSpace)
On Error GoTo Err_fChkFolder
Dim objSent As Outlook.MAPIFolder
Dim objNF As Outlook.MAPIFolder
Dim sCCMS As String
‘ can add this to the funtion parameters and pass the folder name if you want.
sNewFolder = “newfoldername”
Set objSent = objOutlook.GetDefaultFolder(olFolderSentMail)
On Error Resume Next
If objSent.Folders.Count > 0 Then
sNewFolder = objSent.Folders(sNewFolder).Name
‘if folder doesnot exist add the new folder
If Err.Number <> 0 Then
Err.Clear
Set objNF = objSent.Folders.Add(“newfoldername”) ‘can use variable name without quotes
End If
Else ‘if n folders exist
Set objNF = objSent.Folders.Add(“newfoldername”)
End If
If Err.Number > 0 Then
MsgBox “Add of Folder Failed ” & _
vbLf & Str(Err.Number) & ” –> ” & Err.Description
Err.Clear
End If
Exit_fChkFolder:
If Not objSent Is Nothing Then Set objSent = Nothing
If Not objNF Is Nothing Then Set objNF = Nothing
Exit Function
Err_fChkFolder:
MsgBox Str(Err.Number) & ” –> ” & Err.Description
Resume Exit_fChkFolder
End Function
I hope that these two funtions are useful.
RickMan
