Hi,

I am attempting to extract message parts using Sue Mosher's code at
(http://www.outlookcode.com/codedetail.aspx?id=89) into an Access
database, but I receive the following error:

'Runtime error 520617979... The program for the attachment may not have
been installed properly or may have been moved or deleted...'

Here is the code that leads to the error:
'-----------------------------------------------------------
Public Sub WebRegistration()

On Error GoTo WebRegistration_Error

'Outlook Variables

Dim objOL As Outlook.Application
Dim objCurrent As Outlook.Explorer
Dim objSelection As Outlook.Selection
Dim objMail As Outlook.MailItem
Dim objMsg As Object

'Message Body Variables
Dim intLocAddress As Integer
Dim intLocCRLF As Integer
Dim strTitle As String
Dim strFirstName As String
Dim strLastName As String
Dim strEmail As String
Dim strPass As String
Dim strProf As String
Dim strMedSpec As String
Dim strHosp As String
Dim strCity As String
Dim strState As String
Dim strZip As String
Dim strCountry As String
Dim strRegVia As String
Dim strPromo As String

'Access Variables
Dim appAccess As Application
Dim dbsDAO As Database
Dim rstDAO As Recordset
Dim strDBName As String

'Set Outlook
Set objOL = CreateObject("Outlook.Application")
Set objCurrent = objOL.ActiveExplorer
Set objSelection = objCurrent.Selection

'Set MS Access
strDBName = "NETWORK_LOCATION_HERE\Web_Registrations.mdb"
Set appAccess = CreateObject("Access.Application")

'Check existence of database
FileSearch.LookIn = "NETWORK_LOCATION_HERE"
FileSearch.FileName = "Web_Registrations.mdb"
If FileSearch.Execute() > 0 Then
   appAccess.OpenCurrentDatabase strDBName
   Set dbsDAO = CurrentDb
   Set rstDAO = dbsDAO.OpenRecordset("tblWebRegistration")
Else
   MsgBox "Database does not exist.  Exiting"
   appAccess.Quit
End If

For Each objMsg In objCurrent.Selection
   If objMsg.Class = olMail Then
       Set objMail = objMsg
       strTitle = ParseTextLinePair(objMsg.Body, "Title:")
       strFirstName = ParseTextLinePair(objMsg.Body, "First Name:")
       strLastName = ParseTextLinePair(objMsg.Body, "Last Name:")
       strEmail = ParseTextLinePair(objMsg.Body, "Email Address:")
       strPass = ParseTextLinePair(objMsg.Body, "Password:")
       strProf = ParseTextLinePair(objMsg.Body, "Profession:")
       strMedSpec = ParseTextLinePair(objMsg.Body, "Medical
Specialty:")
       strHosp = ParseTextLinePair(objMsg.Body, "Hospital")
       strCity = ParseTextLinePair(objMsg.Body, "City:")
       strState = ParseTextLinePair(objMsg.Body, "State/Province:")
       strZip = ParseTextLinePair(objMsg.Body, "Postal Code:")
       strCountry = ParseTextLinePair(objMsg.Body, "Country:")
       strRegVia = ParseTextLinePair(objMsg.Body, "Registered via:")
       strPromo = ParseTextLinePair(objMsg.Body, "Promotion Code:")
   End If

rstDAO.AddNew

       If strTitle <> vbNullString Then
           rstDAO!Title = strTitle
       End If

       If strFirstName <> vbNullString Then
           rstDAO!FirstName = strFirstName
       End If

       If strLastName <> vbNullString Then
           rstDAO!LastName = strLastName
       End If

       If strEmail <> vbNullString Then
           rstDAO!Email = strEmail
       End If

       If strPass <> vbNullString Then
           rstDAO!Password = strPass
       End If

       If strProf <> vbNullString Then
           rstDAO!Profession = strProf
       End If

       If strMedSpec <> vbNullString Then
           rstDAO!Medicalspecialty = strMedSpec
       End If

       If strHosp <> vbNullString Then
           rstDAO!Hospital = strHosp
       End If

       If strCity <> vbNullString Then
          rstDAO!City = strCity
       End If

       If strState <> vbNullString Then
           rstDAO!State = strState
       End If

       If strZip <> vbNullString Then
           rstDAO!Zip = strZip
       End If
          If strCountry <> vbNullString Then
           rstDAO!Country = strCountry
       End If

       If strRegVia <> vbNullString Then
           rstDAO!RegVia = strRegVia
       End If

       If strPromo <> vbNullString Then
           rstDAO!PromoCode = strPromo
       End If

rstDAO.Update

Next objMsg

rstDAO.Close

MsgBox "Process Complete"

appAccess.Quit

Set objOL = Nothing
Set objCurrent = Nothing
Set objSelection = Nothing
Set objMsg = Nothing
Set appAccess = Nothing

Exit Sub

WebRegistration_Error:
   MsgBox "Error No:  " & Err.Number & "; error message: " &
Err.Description

End Sub
'-----------------------------------------------

Any help you can lend would be appreciated.

Henry