Outlook subject line to database

[alanled]

Hi folks, I've just started using Access and I'm facing my first challenge!
I have created a simple database for use with a technical support service. I receive emails though Outlook with the technical request in the subject line. I would like to some how move/copy the subject text from an incoming email to a selected cell in my database, is this possible? Any help would be most welcome thanks.

 

[Pyro]

It is possible. I have done this sort of thing directly through Outlook using an add-in developed in Visual Studio Tools for Office. You could also just create a userform in Outlook to do the same thing, but if other users need to use it, then distributing it can be a pain in the neck.

It is also possible to do this directly from within Access.

What is your preference for where the event occurs?

In my mind, it makes better sense to process this data directly from within Outlook, as you will likely already be over there when you make the decision that the data needs to go into the database.

 

[alanled]

thanks for your response Pyro.
Basicly, I receive emails on a dedicated technical support email address these are sent from an industrial automation controller and only carry the information i use in the subject line of the email, the body of the email is empty and not used. When a new email arrives I want to move and/or copy the subject line to my database as a new title/case. Idont mind really if it is setup in outlook or access as i will only need to configure a couple of systems.

 

[arnelgp]

pass the complete path and filename (.msg) to the function and it will return the subject.

Public Function subGetEmailSubject(strPathAndFileName As String) As String
    Dim OL As Outlook.Application
    Dim MSG As Outlook.MailItem
    'reference:
    'Microsoft OutLook XX.X Object Library
    
    Set OL = New Outlook.Application
    
    Set MSG = OL.CreateItemFromTemplate(strPathAndFileName)
    subGetEmailSubject = MSG.Subject
    Set MSG = Nothing
    Set OL = Nothing
End Function

 

[alanled]

Many thanks for this, not to be a pain but where do i want to insert the script, outlook or access?

 

[arnelgp]

it is an access code.

 

[alanled]

Many thanks Im a beginner lol

 

[Pyro]

Attached is an example of loading Outlook data into a listbox from Access. It should give you some idea of how to achieve what you are after.

A few notes:

1. This example uses late binding, so a reference to the Outlook Object Library is not required.

2. The data is loaded into the listbox as a value list, so nothing is actually stored in the database.

3. I have set it to loop through 100 emails only, since you could have thousands of emails in your inbox. I have no idea how long that might take

4. I put this together quickly, so it might be buggy!

5. The example file was saved in Access 2000, as i have no idea which version of Access you are running.

 

[alanled]

Many thanks for all your help, my VB is a bit rusty so I will have a look at this thanks again for your time.

 

[Gasman]

Pyro,

Thank you for that code.

I found that my subjects and email addresses were getting swapped due to commas and any semi colon in the subject line.?

For Each objMailItem In objFolder.items
    strSubject = Replace(objMailItem.subject, ",", " ")
    strSubject = Replace(strSsubject, ";", " ")

    
    strRow_Source = strRow_Source & strSubject & "; "

What other characters would have the same effect?

 

[Gasman]

Pyro,

Would you be able to assist in explaining the order of the messages in the folder?

They did not load as they show in the view, so i attempted

strRow_Source = "Subject; Sender Email Address; "
objFolder.Items.Sort "[Received]", True
objFolder.Items.getfirst

'For Each objMailItem In objFolder.items
For intCount = 1 To intMax_To_Load
    Set MyItem = objFolder.Items(intCount)
    strSubject = Replace(MyItem.subject, ",", " ")
    strSubject = Replace(strSubject, ";", " ")

    strRow_Source = strRow_Source & strSubject & "; "
    strRow_Source = strRow_Source & MyItem.SenderEmailAddress & "; "
    
    'intCount = Nz(intCount, 0) + 1
    
    'If intCount = intMax_To_Load Then
    '    Exit For
        
    'End If
    
Next
    
If Right(strRow_Source, 1) = ";" Then
    strRow_Source = Left$(strRow_Source, Len(strRow_Source) - 2)
    
End If

Me.lstEmail.RowSource = strRow_Source

yet the order appears to be a little random, indeed the bottom message never gets included. I tried Items(0) but that produced an index error.

TIA

 

[Pyro]

Below is the code from my example with mail item sorting highlighted in blue.

Private Function GetReqs() As String
On Error GoTo Err_Handler

Dim objOutlook As Object
Dim objNameSpace As Object
Dim objFolder As Object
[COLOR="Blue"]Dim objItems As Object[/COLOR]
Dim objMailItem As Object
Dim strRow_Source As String
Dim intCount As Integer
Dim intMax_To_Load As Integer

Me.lstEmail.RowSource = vbNullString

On Error Resume Next

Set objOutlook = GetObject(, "Outlook.Application")

On Error GoTo Err_Handler

If objOutlook Is Nothing Then
    Set objOutlook = CreateObject("Outlook.Application")
    Set objNameSpace = objOutlook.GetNamespace("MAPI")
    Set objFolder = objNameSpace.getDefaultFolder(6)
    objFolder.Display
    
Else
    Set objNameSpace = objOutlook.GetNamespace("MAPI")
    Set objFolder = objNameSpace.getDefaultFolder(6)
    
End If

intMax_To_Load = 100

strRow_Source = "Subject; Sender Email Address; "

[COLOR="Blue"]Set objItems = objFolder.Items

With objItems
    .Sort "ReceivedTime", True
    
End With[/COLOR]

For Each objMailItem In [COLOR="Blue"]objItems[/COLOR]
    strRow_Source = strRow_Source & objMailItem.Subject & "; "
    strRow_Source = strRow_Source & objMailItem.SenderEmailAddress & "; "
    
    intCount = Nz(intCount, 0) + 1
    
    If intCount = intMax_To_Load Then
        Exit For
        
    End If
    
Next
    
If Right(strRow_Source, 2) = "; " Then
    strRow_Source = Left$(strRow_Source, Len(strRow_Source) - 2)
    
End If

Me.lstEmail.RowSource = strRow_Source

Set objMailItem = Nothing
[COLOR="blue"]Set objItems = Nothing[/COLOR]
Set objFolder = Nothing
Set objNameSpace = Nothing
Set objOutlook = Nothing

Exit_Handler:
    Exit Function

Err_Handler:
    MsgBox Err.Number & " " & Err.Description
    Resume Exit_Handler
    
End Function

 

[Gasman]

That did it.

Thank you.