save an Email from Outlook to an MS Access Table

Hi,

I found this code while looking through EE and thought that it was just what i needed.  I want to allow a user to select an email in Outlook and send it to the tbl_documents table of my Database with a specific customer id associated with it.  The code seems to be succesfully saving the email in the documents folder, but it does not seem to be adding it to the table.

For information, my database BE is MS SQL however the tables are linked into the FE when the database FE is opened.  Should i be treating the database as though the tables were in Access, or should my code be linking directly into MS SQL?

I would greatly appreciate some help on this.

Regards,
Tom
Sub SaveMessageToProjectDatabase()
    Dim olkMsg As Outlook.MailItem, strFilename As String, strProject As String
    If TypeName(Application.ActiveWindow) = "Explorer" Then
        Set olkMsg = Application.ActiveExplorer.Selection(1)
    Else
        Set olkMsg = Application.ActiveInspector.CurrentItem
    End If
    'Change the path on the following line as desired'
    strFilename = "C:\Projects\ContactPLUS Development\documents\" & ReplaceIllegalCharacters(olkMsg.Subject) & ".msg"
    olkMsg.SaveAs strFilename
    strProject = InputBox("What customer do you want save the message to?", "Save Message to Contact Plus")
    If strProject <> "" Then
        AddAttachment strProject, strFilename
    End If
    Kill strFilename
    Set olkMsg = Nothing
End Sub
  
Sub AddAttachment(strProjectName As String, strFilename As String)
    'Edit the values on the next 4 lines'
    Const DBNAME = "C:\Projects\ContactPLUS
Development\ContactPLUS_dev_TESTsoftware.accdb"     '<- Path and filename of database'
    Const TBLNAME = "tbl_documents"            '<- Name of table within the database'
    Const INDXNAME = "company_id"           '<- Name of index to field containing the project name'
    Const ATTFLD = "document_path"          '<- Name of field in the table that holds the attachments'
    Dim accApp As Object, _
        daoDB As Object, _
        daoRS As Object, _
        daoAtt As Object
    Set accApp = CreateObject("Access.Application")
    Set daoDB = accApp.DBEngine(0).OpenDatabase(DBNAME)
    Set daoRS = daoDB.OpenRecordset(TBLNAME)
    daoRS.Index = INDXNAME
    daoRS.Seek "=", strProjectName
    daoRS.Edit
    Set daoAtt = daoRS.Fields(ATTFLD).Value
    daoAtt.AddNew
    daoAtt.Fields("FileData").LoadFromFile strFilename
    daoAtt.Update
    daoRS.Update
    daoAtt.Close
    daoRS.Close
    daoDB.Close
    accApp.Quit 1
    Set daoDB = Nothing
    Set daoRS = Nothing
    Set daoAtt = Nothing
    Set accApp = Nothing
End Sub
  
Function ReplaceIllegalCharacters(strSubject As String) As String
    Dim strBuffer As String
    strBuffer = Replace(strSubject, ":", "")
    strBuffer = Replace(strBuffer, "\", "")
    strBuffer = Replace(strBuffer, "/", "")
    strBuffer = Replace(strBuffer, "?", "")
    strBuffer = Replace(strBuffer, Chr(34), "'")
    strBuffer = Replace(strBuffer, "|", "")
    ReplaceIllegalCharacters = strBuffer
End Function

Open in new window

d10u4vAsked:
Who is Participating?
 
d10u4vConnect With a Mentor Author Commented:
This is what i have done. Seems to be working.
Sub SaveMessageToProjectDatabase()
    Dim olkMsg As Outlook.MailItem, strFilename As String, strProject As String, strMessage As String
    If TypeName(Application.ActiveWindow) = "Explorer" Then
        Set olkMsg = Application.ActiveExplorer.Selection(1)
    Else
        Set olkMsg = Application.ActiveInspector.CurrentItem
    End If
    'Change the path on the following line as desired'
    strMessage = olkMsg
    strFilename = "D:\Projects\ContactPLUS Development\documents\" & ReplaceIllegalCharacters(olkMsg.Subject) & ".msg"
    olkMsg.SaveAs strFilename
    strProject = InputBox("What project should I save the message to?", "Save Message to Project Database")
    If strProject <> "" Then
        AddAttachment strProject, strFilename, strMessage
    End If
    'Kill strFilename
    Set olkMsg = Nothing
End Sub
  
Sub AddAttachment(strProjectName As String, strFilename As String, strMessage As String)
    'Edit the values on the next 4 lines'
    Const DBNAME = "D:\Projects\ContactPLUS Development\ContactPLUS_dev_TESTsoftware.accdb"     '<- Path and filename of database'
    Const TBLNAME = "tbl_documents"            '<- Name of table within the database'
    Const INDXNAME = "company_id"           '<- Name of index to field containing the project name'
    Const TXTFLD = "document_path"          '<- Name of field in the table that holds the attachments'
    Dim accApp As Object, daoDB As Object, daoRS As Object
    Set accApp = CreateObject("Access.Application")
   
    Dim db As DAO.Database
    Dim rs As DAO.Recordset


    Set db = CurrentDb
    Set rs = db.OpenRecordset(TBLNAME, dbOpenDynaset, dbSeeChanges, dbOptimistic)


        rs.AddNew
        rs("document_path") = strFilename
        rs("company_id") = strProjectName
        rs("file_type") = "Email"
        rs("document_desc") = strMessage
        rs.Update
        
        rs.Close
        db.Close
        
    Set rs = Nothing
    Set db = Nothing

Set accApp = Nothing

End Sub
  
Function ReplaceIllegalCharacters(strSubject As String) As String
    Dim strBuffer As String
    strBuffer = Replace(strSubject, ":", "")
    strBuffer = Replace(strBuffer, "\", "")
    strBuffer = Replace(strBuffer, "/", "")
    strBuffer = Replace(strBuffer, "?", "")
    strBuffer = Replace(strBuffer, Chr(34), "'")
    strBuffer = Replace(strBuffer, "|", "")
    ReplaceIllegalCharacters = strBuffer
End Function

Open in new window

0
 
Helen FeddemaCommented:
Your code is using an Access 2007 Attachment field to store the saved Outlook message.  I don't know if this would work with a SQL Server back end, but I suspect it would not.  The code looks OK for Access 2007.
0
 
Helen FeddemaCommented:
I have similar code that loads saved files to Attachment fields in Access 2007.
0
 
d10u4vAuthor Commented:
Oh,  I was unaware that it was using an attachment field.  Sorry.

Is it possible to just send the path of the document which was created in the first part of the code (email) to a standard text field in the tbl_documents table?

What i'm trying to achieve is the ability for a user to select an email in Outlook and then press the button i have assigned the macro to in Outlook and then enter the customer number ID and have the email saved to the documents folder and the path to this email saved in the tbl_documents table.

I hope i'm making sense :)

Tom
0
 
d10u4vAuthor Commented:
Hi,

Can anyone help me with this question?  The code is saving the email to the folder, but i'm having problems trying to re-write the code to save the link to this saved email in the tbl_documents table with the customer number entered by the user.

Thanks,

Tom
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.