'Create constants
Const olFolderInbox = 6
'Create variables
Dim olkApp, olkSes, olkFld, olkDoc, adoCon, adoRec, strFileType
'Connect to Outlook
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
'Change the default profile name on the next line as needed
olkSes.Logon "Outlook"
'Change the folder as needed
Set olkFld = olkSes.GetDefaultFolder(olFolderInbox)
'Connect to the database table
Set adoCon = CreateObject("ADODB.Connection")
'Edit the connection string on the next line.
adoCon.Open "Connection_String_Goes_Here"
'Edit the SQL statement on the next line as needed
Set adoRec = adoCon.Execute("SELECT * FROM Table_Name")
'Process the records
With adoRec
Do Until .EOF
Set olkDoc = olkFld.Items.Add("IPM.Document")
'Edit the field name on the next line
olkDoc.Attachments.Add .Fields("Name_of_File_Path_Field")
'Edit the field name on the next line
olkDoc.Subject = .Fields("Name_of_File_Name_Field")
'Edit the field names on the next line
strFileType = Mid(.Fields("Name_of_File_Name_Field"), InStrRev(.Fields("Name_of_File_Name_Field"), ".") + 1)
'Add more file types as needed
Select Case LCase(strFileType)
Case "doc"
olkDoc.MessageClass = "IPM.Document.Word.Document.8"
Case "docx"
olkDoc.MessageClass = "IPM.Document.Word.Document.12"
Case "pdf"
olkDoc.MessageClass = "IPM.Document.AcroExch.Document"
Case "ppt"
olkDoc.MessageClass = "IPM.Document.PwerPoint.Show.8"
Case "pptx"
olkDoc.MessageClass = "IPM.Document.PwerPoint.Show.12"
Case "txt"
olkDoc.MessageClass = "IPM.Document.txtfile"
Case "xlsm"
olkDoc.MessageClass = "IPM.Document.Excel.SheetMacroEnabled.12"
Case "xls"
olkDoc.MessageClass = "IPM.Document.Excel.Sheet.8"
Case "xlsx"
olkDoc.MessageClass = "IPM.Document.Excel.Sheet.12"
Case "zip"
olkDoc.MessageClass = "IPM.Document.WinZip"
End Select
olkDoc.Save
.MoveNext
Loop
End With
'Clean up
adoRec.Close
adoCon.Close
olkSes.Logoff
Set adoRec = Nothing
Set adoCon = Nothing
Set olkDoc = Nothing
Set olkFld = Nothing
Set olkSes = Nothing
Set olkApp = Nothing
msgbox "Import complete.", vbInformation + vbOKOnly, "Import Files to Outlook"
WScript.Quit
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (0)