Access not detecting correct version of Outlook (1 Viewer)

[isladogs]

Its very easy but you do need to know your email settings which you can get from e.g. Outlook!
If you can send an email from the example app, the same code will work in any Access app.

 

[Pat Hartman]

Communicating with Access via email is possible for simple things. Sending email is pretty easy. You can use plain text or HTML. You can send attachments. Access can read email but parsing text strings can be difficult unless they are simple or your people can be trusted to be very disciplined in how they format the return email. You might have more success if you use an Excel file as an attachment to the email. Access can download the excel file and import it with very few lines of code.

 

[gemma-the-husky]

It might be worth looking at this thread which also deals with differences between Access and Outlook versions

https://access-programmers.co.uk/forums/showthread.php?t=307416

 

[The_Doc_Man]

A word of warning: You CAN send e-mail through CDO and it works like a champ. But if you are going to want to RECEIVE e-mails, it won't be through CDO. You will need to identify your e-mail server that will be storing the emails and use MAPI to do this.

http://www.utteraccess.com/forum/lofiversion/index.php/t2013397.html

https://social.msdn.microsoft.com/F...g-cdo-object-in-vbapplication?forum=vbgeneral

 

[Alc]

Okay, so the following works for what we need. It's a simplified version of what I was originally asked for, but it's going to do the trick.

Background
1. Someone is sent an email with a link to a document they have to review.
2. A list of emails sent is stored in a local table
3. They reply with any comments they have
4. The following code is run once a day and looks for any responses that have arrived, copies the relevant info to an Access table, then marks each email as read and copies it to a sub folder

If we decide to ask specific questions in the future, the function that currently strips out the response so it can be stored can be pretty easily adapted to record each response separately. The person just needs to reply to the email and enter their answer into a space following each question.

I fully appreciate that there will be more efficient ways to accomplish what I did, but it was very much a case of 'just get it working' and I've never claimed to be an artist

Hopefully, it'll help someone who has a similar problem.

Option Explicit

Const DBPath = "{path to db back end}"
Const MailboxToScan = "{my email address}"

Private Sub Command0_Click()
    Export_Responses_to_Access
End Sub

Private Function GetFolder(strFolderPath As String, ByRef Mailbox As Outlook.MAPIFolder) As MAPIFolder
  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 objFolder = Mailbox.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
End Function

Public Sub Export_Responses_to_Access()
    Dim Db As Database
    Dim ItemsToProcess As Outlook.Items
    Dim ldSentDate As Date
    Dim liInitialCount As Integer
    Dim liRecordCount As Integer
    Dim objOL As Object
    Dim oInbox As Outlook.MAPIFolder
    Dim oProcessed As Outlook.MAPIFolder
    Dim Rst As DAO.Recordset
    Dim strSubject As String
    
    DoCmd.SetWarnings False

    Set objOL = CreateObject("Outlook.Application")
    Set oInbox = objOL.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set oProcessed = oInbox.Folders("Service Bulletins")
    Set Db = CurrentDb
    Set Rst = Db.OpenRecordset("SELECT Subject FROM tblEmailsSent;")
    If Not Rst.EOF Then
        Rst.MoveLast
        liInitialCount = Rst.RecordCount

        Rst.MoveFirst

        Do While Not Rst.EOF
            strSubject = Rst!Subject

            Call Find_Responses(strSubject, Db, oInbox, oProcessed)
            strSubject = ""

            Rst.MoveNext
        Loop
    End If
    
    Set objOL = Nothing
    Set oInbox = Nothing
    Set oProcessed = Nothing
    Set ItemsToProcess = Nothing
    Db.Close
    Set Db = Nothing
    Set Rst = Nothing
    
    DoCmd.SetWarnings True
End Sub

Sub Find_Responses(ByVal strSubject As String, _
                   Db As DAO.Database, _
                   oInbox As Outlook.MAPIFolder, _
                   oProcessed As Outlook.MAPIFolder)
    Dim ldRespondedDate As Date
    Dim ldSentDate As Date
    Dim liCount As Integer
    Dim Mailbox As Outlook.MAPIFolder
    Dim objMail As Outlook.MailItem
    Dim objNamespace As Outlook.NameSpace
    Dim objOutlook As Outlook.Application
    Dim objRecipient As Outlook.Recipient
    Dim propertyAccessor As Outlook.propertyAccessor
    Dim Rst2 As DAO.Recordset
    Dim strBody As String
    Dim strRecipient As String
    Dim strResponse As String

    Set Rst2 = Db.OpenRecordset("SELECT * FROM tblEmailsReceived;") ' Used for appending new records

    oInbox.Items.Sort "ReceivedTime", False   
    
    liCount = 0
    For Each objMail In oInbox.Items
    
        'On Error Resume Next
        Set propertyAccessor = objMail.propertyAccessor
        
        'Look for all replies received that relate to the original email, based on Subject
        If objMail.Subject Like ("RE: " & strSubject & "*") Then
            ldSentDate = objMail.SentOn
            strRecipient = objMail.SenderName
            strResponse = Clean_Response(objMail.Body, strRecipient)
            ldRespondedDate = objMail.SentOn

            ' Store required data in Access
            With Rst2
                .AddNew
                !Subject = strSubject
                !Response = strResponse
                !Respondent = strRecipient
                !ResponseDate = ldRespondedDate
                .Update
            End With
            
            objMail.UnRead = False
            objMail.Move oProcessed

            liCount = liCount + 1
            
        End If
    
        DoEvents
                
    Next

Exit_Sub:

    Set Rst2 = Nothing

    Exit Sub

Err_Handler:
    MsgBox Err.Number & Chr(13) & Err.Description, vbExclamation
    Resume Exit_Sub
    Resume
End Sub

Public Function Clean_Response(ByVal strEnteredString As String, ByVal strRecipient As String) As String
    Dim n As Integer
    Dim liPosition As Integer

    For n = 1 To 31
      strEnteredString = Replace(strEnteredString, Chr(n), "")
    Next n

    liPosition = InStr(strEnteredString, strRecipient)

    If InStr(strEnteredString, "From:") < liPosition Then
        liPosition = InStr(strEnteredString, "From: ")
    End If
    strEnteredString = Left(strEnteredString, liPosition - 1)

    Clean_Response = strEnteredString
End Function

 

[theDBguy]

Hi. Congratulations! Glad to hear you found a solution that works for you. Cheers!