Outlook Automation-having trouble saving mi.body to database memo fld

[SBendBuckeye]

Helped a guy with the following code to save certain email messages into an Access database. The body field in the database is a memo because of large email message size variations. In testing it, the code errored out until I stripped the carriage returns, line feeds, etc. out.

Am I missing something here? What I really want to do is use some kind of a blob function to dump whatever is in the email body into this memo field without messing with it.

Can I do that? Any help would be appreciated!

Private Sub Application_NewMail()
Dim mf As MAPIFolder
Dim ns As NameSpace
Dim mi As MailItem
Dim strSQL As String
Dim appAccess As Access.Application
Dim strBody As String

Set ns = Application.GetNamespace("MAPI&quot
Set mf = ns.GetDefaultFolder(olFolderInbox)
'Return reference to Microsoft Access Application object
Set appAccess = New Access.Application
' Open database in Microsoft Access.
appAccess.OpenCurrentDatabase _
"F:\Windows\Access\Access2\CitiesAndStates.mdb"
strBody = FixBody(mi.Body) '<= wouldn't work w/out this
strSQL = &quot;INSERT INTO tblJimTest &quot; _
& &quot;([From], [To], [CC], [BCC], [Subject], [Body]) &quot; _
& &quot;VALUES ('','&quot; & mi.To & &quot;','&quot; & mi.CC & &quot;','&quot; _
& mi.BCC & &quot;','&quot; & mi.Subject & &quot;','&quot; & strBody _
& &quot;');&quot;
appAccess.DoCmd.RunSQL strSQL
appAccess.CloseCurrentDatabase
Set appAccess = Nothing
End Sub

Private Function FixBody(pstr As String)
Dim strBody As String
Dim intPos As Integer
Dim strChar As String
strBody = vbNullString
For intPos = 1 To Len(pstr)
strChar = Mid$(pstr, intPos, 1)
Select Case strChar
Case vbCrLf, vbCr, vbLf, vbTab
Case Else
strBody = strBody & strChar
End Select
Next intPos
FixBody = strBody
End Function

Thanks in advance for any help you can give me!