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.
Dim olkMsg As Outlook.MailItem, strFilename As String, strProject As String
If TypeName(Application.ActiveWindow) = "Explorer" Then
Set olkMsg = Application.ActiveExplorer.Selection(1)
Set olkMsg = Application.ActiveInspector.CurrentItem
'Change the path on the following line as desired'
strFilename = "C:\Projects\ContactPLUS Development\documents\" & ReplaceIllegalCharacters(olkMsg.Subject) & ".msg"
strProject = InputBox("What customer do you want save the message to?", "Save Message to Contact Plus")
If strProject <> "" Then
AddAttachment strProject, strFilename
Set olkMsg = Nothing
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
Set daoAtt = daoRS.Fields(ATTFLD).Value
Set daoDB = Nothing
Set daoRS = Nothing
Set daoAtt = Nothing
Set accApp = Nothing
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