Rocky Smolin - Beach Access Software
bchacc at san.rr.com
Fri Jun 2 15:40:42 CDT 2006
Dan:
Thanks. I'm going to start with Kath's and fill in the blanks with this
one.
Regards,
Rocky
Dan Waters wrote:
> Hi Rocky,
>
> Heenan Lambert gave me some code once which I was able to use to great
> effect. Below are three procedures which I now use to select any Outlook
> folder, and then select an email within that folder. This is code behind a
> form
>
> The primary procedure that will help is called SelectOutlookMAPIFolder.
> It's the second one shown here.
>
> Also - look at the error messages - they do help a user to understand
> Microsoft's 'An application is trying to send messages on your behalf . . .'
> warning.
>
> ----------------------------------------------------------------------------
>
> Private Sub butAttachEmail_Click()
> If ErrorTrapping = True Then On Error GoTo EH
>
> Dim stgDestination As String
>
> '-- Can't Attach over an existing file
> If Not IsNull(txtPartFileTitle) Then
> FormattedMsgbox GstgNotReady, "The file " _
> & vbCrLf & vbCrLf _
> & txtPartFileTitle _
> & vbCrLf & vbCrLf _
> & " is already attached here, and you cannot attach another file
> over it.@ @", vbExclamation + vbOKOnly, "Cannot Attach Over an Existing
> File"
> Exit Sub
> End If
>
> Set modMAPIFolder = SelectOutlookMAPIFolder
> If modMAPIFolder Is Nothing Then
> Exit Sub
> End If
>
> Call CreateMessgeList
>
> DoCmd.OpenForm "frmAttachEmail", , , , , acDialog
>
> Set modMAPIFolder = Nothing
>
> Exit Sub
>
> EH:
> Application.Echo True
> DoCmd.SetWarnings True
> GlngErrNumber = Err.Number
> GstgErrDescription = Err.Description
> Select Case GlngErrNumber
> Case 287
> FormattedMsgbox GstgReminder, "To directly store an email as a
> file, you must allow Access to your email." _
> & vbCrLf & vbCrLf _
> & "First, check the Allow Access checkbox to allow 1 minute
> of access to your email list." _
> & vbCrLf & vbCrLf _
> & "Then push the Yes button.@ @", vbExclamation + vbOKOnly,
> "You must grant allow Access to your email!"
> Case Else
> Call GlobalErrors("", GlngErrNumber, GstgErrDescription,
> Me.Name, "butAttachEmail")
> End Select
>
> End Sub
>
> ----------------------------------------------------------------------------
>
> Private Function SelectOutlookMAPIFolder() As Outlook.MAPIFolder
> If ErrorTrapping = True Then On Error GoTo EH
>
> Dim oParentMailItem As Outlook.MailItem
> Dim oParentFolder As Outlook.MAPIFolder
> Dim olApp As Outlook.Application
>
> Set olApp = CreateObject("Outlook.Application")
>
> Continue:
> Set oParentFolder = olApp.GetNamespace("MAPI").PickFolder
>
> If oParentFolder Is Nothing Then
> Exit Function
> End If
>
> If oParentFolder.DefaultItemType <> olMailItem Or oParentFolder.Name =
> "Deleted Items" Then
> FormattedMsgbox GstgNotReady, "You must select a Mail Folder!@ @",
> vbExclamation + vbOKOnly, "Mail Folder Only"
> Set oParentFolder = Nothing
> GoTo Continue
> End If
>
> If oParentFolder.Items.Count = 0 Then
> FormattedMsgbox GstgNotReady, "There are no Items in the folder " _
> & vbCrLf & vbCrLf _
> & oParentFolder.Name & ".@ @", vbExclamation + vbOKOnly, "No
> Email Items"
> Set oParentFolder = Nothing
> GoTo Continue
> End If
>
> Set SelectOutlookMAPIFolder = oParentFolder
>
> Set oParentFolder = Nothing
>
> Exit Function
>
> EH:
> Application.Echo True
> Call GlobalErrors("", Err.Number, Err.Description, Me.Name,
> "SelectOutlookMAPIFolder")
>
> End Function
>
> ----------------------------------------------------------------------------
>
> Private Sub CreateMessgeList()
> If ErrorTrapping = True Then On Error GoTo EH
>
> Dim objMailItem As Outlook.MailItem
> Dim stgFileName As String
> Dim lngItemNumber As Long
> Dim stgSubject As String
> Dim stgSetOrder As String
>
> DoCmd.SetWarnings False
> DoCmd.RunSQL "DELETE * FROM tblFEAttachEmails"
> DoCmd.SetWarnings True
>
> With modMAPIFolder
> If .Items.Count > 0 Then
> SysCmd acSysCmdInitMeter, "Creating Email List", .Items.Count
> For lngItemNumber = 1 To .Items.Count
> On Error Resume Next
> Set objMailItem = .Items(lngItemNumber)
> On Error GoTo 0
> With objMailItem
> stgSubject = Replace(CleanFileName(.Subject), "'", "''")
> DoCmd.SetWarnings False
> DoCmd.RunSQL "INSERT INTO tblFEAttachEmails (Subject,
> FromName, DateReceived, MessageNumber)" _
> & " VALUES ('" & stgSubject & "', '" &
> Replace(.SenderName, "'", "''") & "', #" & .ReceivedTime & "#, " &
> lngItemNumber & ");"
> DoCmd.SetWarnings True
> End With
> SysCmd acSysCmdUpdateMeter, lngItemNumber
> Next lngItemNumber
> SysCmd acSysCmdClearStatus
> End If
> End With
>
> Set objMailItem = Nothing
>
> Exit Sub
>
> EH:
> Application.Echo True
> DoCmd.SetWarnings True
> GlngErrNumber = Err.Number
> GstgErrDescription = Err.Description
> Select Case GlngErrNumber
> Case 287
> FormattedMsgbox GstgReminder, "To directly store an email as a
> file, you must allow Access to your email." _
> & vbCrLf & vbCrLf _
> & "First, check the Allow Access checkbox to allow 1 minute
> of access to your email list." _
> & vbCrLf & vbCrLf _
> & "Then push the Yes button.@ @", vbExclamation + vbOKOnly,
> "You must allow Access to your email!"
> Case Else
> Call GlobalErrors("", GlngErrNumber, GstgErrDescription,
> Me.Name, "Create Message List")
> End Select
>
> End Sub
>
> ----------------------------------------------------------------------------
>
> Best of Luck!
> Dan
>
>
> -----Original Message-----
> Subject: [AccessD] Outlook Automation
>
> Dear List:
>
> I need to look in a specific outlook folder for mail. I can't find the
> syntax for this. Can anyone point me in the right direction?
>
> MTIA
>
> Rocky
>
>
--
Rocky Smolin
Beach Access Software
858-259-4334
www.e-z-mrp.com