Message Parse to Access Database

[hstockbridge5]

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

 

[Sue Mosher [MVP-Outlook]]

Could you tell us what code statement raises the error?

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers

 

[hstockbridge5]

Sue,

The message is thrown at

Set appAccess = CreateObject("Access.Application")

Henry

 

[Sue Mosher [MVP-Outlook]]

Perhaps a dumb question, but do you have Microsoft Access installed on the machine where the code is running?

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003

and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers

 

[hstockbridge5]

Yes. Access 97 full version and Access 2003 Run-Time.

 

[hstockbridge5]

Sue,

I changed a couple lines of code, and now I'm set...

Dim appAccess as Object
Set appAccess = CreateObject("Access.Application.8")

Henry