General discussion


Create a new folder from Access 2002

By jenni ·
Is it possible to create a new folder from within an access form?. My client wants to keep all corrspondence for his client in a special folder and would like this folder created automatically. Is this possible and if so how?

This conversation is currently closed to new comments.

Thread display: Collapse - | Expand +

All Comments

Collapse -

Create an Outlook Folder

by RickMan In reply to Create a new folder from ...


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

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

If Not objSent Is Nothing Then Set objSent = Nothing
If Not objNF Is Nothing Then Set objNF = Nothing
Exit Function

MsgBox Str(Err.Number) & " --> " & Err.Description
Resume Exit_fChkFolder

End Function

I hope that these two funtions are useful.


Related Discussions

Related Forums