Macro to populate contact fields no longer working

[RitaP]

Amateur using VBA. I copied and customized this macro a while ago and it
worked until I upgraded to Outlook 2007. What I'm doing is populating contact
fields, name, address, phone, email address from an email that contains info
in the body. The macro still creates a contact and puts it in correct contact
folder but the fields are no longer populated with info. The info I input is
being put correctly into notes section.

I haven't had time to dig in to this. Wonder if anyone can help since I
don't have new books on Outlook 2007 vba to help me. Thanks.
Rita

Macro

Sub WebContactCreateV3()

Dim objApp As Application
Dim objNS As NameSpace
Dim ContactsFolder As MAPIFolder
Dim TargetFolder As Outlook.MAPIFolder
Dim oInspector As Inspector
Dim objItem As Object
Dim objCurItem As Object
Dim strBody As String
Dim strCustnum, strSalePer, strLimits As String
Dim objContact As ContactItem
Dim strFirstName As String
Dim strLastName As String
Dim strFileAs As String
Dim strCompany As String


strCustnum = InputBox("Customer Number")
strSalePer = InputBox("Salesperson")
strLimits = InputBox("Limits")

Set objApp = Application
Set objNS = objApp.GetNamespace("MAPI")
Set oInspector = objApp.ActiveInspector
Set objItem = oInspector.CurrentItem

If oInspector Is Nothing Then
objNS.GetDefaultFolder(olFolderInbox).Items.GetFirst.Display
Set oInspector = objApp.ActiveInspector
End If

oInspector.Activate
Select Case oInspector.EditorType
Case olEditorText
BlnIsHTML = False
strBody = objItem.Body
X = InStr(1, strBody, "Name:")
Y = InStr(1, strBody, "Title:")
A = X + 6
B = Y - A
FullName = Mid(strBody, A, B)
X = Y
Y = InStr(1, strBody, "Company:")
A = X + 7
B = Y - A
JobTitle = Mid(strBody, A, B)
X = Y
Y = InStr(1, strBody, "Address 1:")
A = X + 9
B = Y - A
Company = Mid(strBody, A, B)
X = Y
Y = InStr(1, strBody, "Address 2:")
A = X + 11
B = Y - A
Address1 = Mid(strBody, A, B)
X = Y
Y = InStr(1, strBody, "City:")
A = X + 11
B = Y - A
Address2 = Mid(strBody, A, B)
X = Y
Y = InStr(1, strBody, "State:")
A = X + 6
B = Y - A
City = Mid(strBody, A, B)
X = Y
Y = InStr(1, strBody, "Zipcode:")
A = X + 7
B = Y - A
State = UCase(Mid(strBody, A, B))
X = Y
Y = InStr(1, strBody, "Phone:")
A = X + 9
B = Y - A
Zipcode = Mid(strBody, A, B)
X = Y
Y = InStr(1, strBody, "Fax:")
A = X + 7
B = Y - A
Phone = Mid(strBody, A, B)
X = Y
Y = InStr(1, strBody, "Email:")
A = X + 5
B = Y - A
Fax = Mid(strBody, A, B)
X = Y
Y = InStr(1, strBody, "SAL B")
A = X + 7
B = Y - A
Cemail = Mid(strBody, A, B)
End Select
Set objItem = objApp.ActiveExplorer.Selection.Item(1)
Set objContact = objApp.CreateItem(olContactItem)
objContact.FullName = FullName
objContact.JobTitle = JobTitle
objContact.CompanyName = Company
objContact.BusinessAddressStreet = Address1 & Address2
objContact.BusinessAddressCity = City
objContact.BusinessAddressState = State
objContact.BusinessAddressPostalCode = Zipcode
objContact.BusinessTelephoneNumber = Phone
objContact.BusinessFaxNumber = Fax
objContact.Email1Address = Cemail
objContact.Body = "Cust # " & strCustnum & vbCrLf & "Salesperson: "
& strSalePer & vbCrLf & "Limits: " & strLimits & strBody
objContact.Categories = "Web Customer"
With objContact
strCompany = .CompanyName
strFirstName = .FirstName
strLastName = .LastName
strFileAs = strCompany & " (" & strLastName & ", " &
strFirstName & ")"
.FileAs = strFileAs
.Display

End With

objContact.Save

Set objCurItem = Application.ActiveInspector.CurrentItem
Set ContactsFolder =
Application.Session.GetDefaultFolder(olFolderContacts)
Set TargetFolder = ContactsFolder.Folders("Web Customers")
Set objCurItem = objCurItem.Move(TargetFolder)

End Sub

What Subject field of email looks like: 2 blank lines then

Account: username
Password: abcdefg
Name: John Doe
Title: Operations Manager
Company: XYZ, Inc.
Address 1: 343 Smith Avenue
Address 2:
City: Anycity
State: PA
Zipcode: 12345
Phone: 555-123-4567
Fax:
Email: (e-mail address removed)
SAL Branch: Crafton
SAL Primary Order Dept: Equipment
View AR: No
View Orders: Yes
View Invoices: Yes
View Items: Yes
Enter Orders: Yes
Change Password: Yes

 

[Sue Mosher [MVP-Outlook]]

I suspect that if you stepped through the code -- an essential basic troubleshooting step -- you'd find that EditorType is not olEditorText. You can probably take out the Select Case, Case, and End Select statements and have the code work fine.

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

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

 

[RitaP]

Sue, thank you, that was it. Love your books and just preordered your Outlook
2007 book at Amazon.com - you're such a great help to the user community!

Rita