Improving Your Outlook

You can use Microsoft Word or Excel to print a variety of information from Outlook. You can even automate Word or Excel to grab information from Outlook and output it into a spreadsheet or a document. Doing this can enable you to create complex reports from an Outlook item or an Outlook folder. You can even back up all items in a folder by copying them to a database.

The following code takes items in a public folder and writes the data from those items to an Access database. I actually used this code when I had to convert an existing public folder application without a backend database to a new revision that used an Access database.

The application stores pre-order information for a manufacturing process. An item is entered in the public folder that contains technical specifications for an item. After all specifications have been entered, the information is used to create pricing for the item. That pricing is then passed on to the customer. I was able to run this code to export all existing data from the public folder into the database so that users could access reports all the way back to the beginning of the application's launch.

The database consists of two tables. The first table, FRAMEItems, stores the majority of the data from each form. Customer information, item information, and technical specifications are all stored in the FRAMEItems table. The second table, FRAMEQuantities, stores information about order quantities for each of the items in the public folder.

 Sub ImportFrameOrderToDatabase() On Error GoTo errhandler Dim olApp As Outlook.Application Dim olns As Outlook.NameSpace Dim olFrameFolder As Outlook.MAPIFolder Dim olFrameItem As PostItem Dim objConn As ADODB.Connection Dim objrst As ADODB.Recordset Dim objQtyrst As ADODB.Recordset Dim objField As ADODB.Field Dim strSQL As String Dim strQtySQL As String 'Set an object variable for the Outlook Application object Set olApp = CreateObject("Outlook.Application") Set olns = olApp.GetNamespace("MAPI") 'Set an object variable for the folder in question Set olFrameFolder = olns.Folders("Public Folders").Folders("All _ Public Folders").Folders("FrameOrderSystem") 'Get the first item in the folder Set olFrameItem = olFrameFolder.Items.GetFirst 'Open Database Connection Set objConn = CreateObject("ADODB.Connection") Set objrst = CreateObject("ADODB.Recordset") Set objQtyrst = CreateObject("ADODB.Recordset") objConn.Mode = adModeReadWrite objConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data _   Source=c:\FrameReports\Frame.mdb;" strSQL = "SELECT * FROM FrameItems;" strQtySQL = "SELECT * FROM FrameQuantities;" objrst.Open strSQL, objConn, adOpenDynamic, adLockOptimistic objQtyrst.Open strQtySQL, objConn, adOpenDynamic, adLockOptimistic For i = 1 To olFrameFolder.Items.Count     'add each item to the database     Set olFrameItem = olFrameFolder.Items(i)     If (olFrameItem.MessageClass = "IPM.Post.FrameOrder") _ And (olFrameItem.userproperties("Status") = "Complete") Then         'add to database     objrst.AddNew     objrst.Fields("RequestNumber") = olFRAMEItem.userproperties("OrderNumber")     objrst.Fields("CustCode") = olFRAMEItem.userproperties("CustCode")     objrst.Fields("Customer") = olFRAMEItem.userproperties("CustomerName")     objrst.Fields("CreationDate") = olFRAMEItem.userproperties("CreationDate")     objrst.Fields("SalesRep") = olFRAMEItem.userproperties("SalesRep")     objrst.Fields("CSR") = olFRAMEItem.userproperties("CSR")     objrst.Fields("Status") = olFRAMEItem.userproperties("Status")     objrst.Fields("DueDate") = olFRAMEItem.userproperties("DueDate")     objrst.Fields("WoodStain") = olFRAMEItem.userproperties("WoodStain")     objrst.Fields("FrameStyle") = olFRAMEItem.userproperties("FrameStyle")     objrst.Fields("NumColors") = olFRAMEItem.userproperties("NumColors")     objrst.Fields("Length") = olFRAMEItem.userproperties("txtLength")     objrst.Fields("Width") = olFRAMEItem.userproperties("txtWidth")     objrst.Fields("Coating") = olFRAMEItem.userproperties("Coating")     objrst.Fields("Etching") = olFRAMEItem.userproperties("Etching")     objrst.Fields("Extras") = olFRAMEItem.userproperties("Extras")     objrst.Fields("Hanger") = olFRAMEItem.userproperties("Hanger")     objrst.Fields("MetalType") = olFRAMEItem.userproperties("MetalType")     objrst.Fields("ShipTo1") = olFRAMEItem.userproperties("ShipTo1")     objrst.Fields("ShipQuantity1") = olFRAMEItem.userproperties("ShipQuantity1")     objrst.Fields("ShipVia2") = olFRAMEItem.userproperties("ShipVia1")     objrst.Fields("ShipTo2") = olFRAMEItem.userproperties("ShipTo2")     objrst.Fields("ShipQuantity2") = olFRAMEItem.userproperties("ShipQuantity2")     objrst.Fields("ShipVia2") = olFRAMEItem.userproperties("ShipVia2")     objrst.Update         'Code here to add all non-zero quantities to the FRAMEQuantities table         If olFRAMEItem.userproperties("Quantity1") <> 0 Then             objQtyrst.AddNew             objQtyrst.Fields("OrderNumber") = _                olFRAMEItem.userproperties("OrderNumber")             objQtyrst.Fields("Quantity1") = _               olFRAMEItem.userproperties("Quantity1")             objQtyrst.Fields("Price1") = olFRAMEItem.userproperties("Price1")             objQtyrst.Fields("Notes1") = olFRAMEItem.userproperties("Notes1")             objQtyrst.Update         End If         If olFRAMEItem.userproperties("Quantity2") <> 0 Then             objQtyrst.AddNew             objQtyrst.Fields("OrderNumber") = _                olFRAMEItem.userproperties("OrderNumber")             objQtyrst.Fields("Quantity2") = _               olFRAMEItem.userproperties("Quantity2"             objQtyrst.Fields("Price2") = olFRAMEItem.userproperties("Price2")             objQtyrst.Fields("Notes2") = olFRAMEItem.userproperties("Notes2")             objQtyrst.Update         End If         End If Next objQtyrst.Close objrst.Close objConn.Close Set oFRAMEItem = Nothing Set oFRAMEFolder = Nothing Set olns = Nothing Set olApp = Nothing Exit Sub errhandler: 'The error handler allows me to know which items were not added 'to the database and why.  'You could also write these errors to a text file     Debug.Print olFRAMEItem.userproperties("OrderNumber")     Debug.Print olFRAMEItem.userproperties("CustomerName")     Debug.Print "was not added to the database."     Debug.Print Err.Description     Exit Sub End Sub