PDA

View Full Version : Insert Contact Information into Word Document



DiamondLaw
12-30-2011, 04:05 PM
I followed directions from an article on how to create a userform in Word via VBA to insert contact information into a Word document from Outlook contacts. The code was written for Office 2000, I think, and I am working on Office 2007. I assume that the code may be outdated and that is why my form is not working.

The code is as follows:


Public Sub InsertIntoDoc(All As Boolean)
Dim itm As Variant
With lstFieldList
For x = 0 To .ListCount - 1
If All Then .Selected(x) = All
If .Selected(x) = True Then
With Selection
.InsertAfter (lstFieldList.List(x))
.Collapse (wdCollapseEnd)
.Paragraphs.Add
End With
End If
Next x
End With
End Sub

Private Sub UserForm_Initialize()
Dim oApp As Outlook.Application
Dim oNspc As NameSpace
Dim oItm As ContactItem
Dim x As Integer
If Not DisplayStatusBar Then
DisplayStatusBar = True
End If
StatusBar = "Please Wait..."
x = 0
Set oApp = CreateObject("Outlook.Application")
Set oNspc = oApp.GetNamespace("MAPI")
For Each oItm In oNspc.GetDefaultFolder _
(olFolderContacts).Items
With Me.cboContactList
.AddItem (oItm.FullName)
.Column(1, x) = oItm.BusinessAddress
.Column(2, x) = oItm.BusinessAddressCity
.Column(3, x) = oItm.BusinessAddressState
.Column(4, x) = oItm.BusinessAddressPostalCode
.Column(5, x) = oItm.Email1Address
End With
x = x + 1
Next oItm
StatusBar = ""
Set oItm = Nothing
Set oNspc = Nothing
Set oApp = Nothing
End Sub

Private Sub cboContactList_Change()
Dim x As Integer
With lstFieldList
If .ListCount > 0 Then
For x = 0 To .ListCount - 1
.RemoveItem (0)
Next x
End If
For x = 0 To cboContactList.ColumnCount - 1
.AddItem (Me.cboContactList.Column(x))
Next x
End With
End Sub

Private Sub cmbAll_Click()
Call InsertIntoDoc(True)
End Sub

Private Sub cmbDetail_Click()
Call InsertIntoDoc(False)
End Sub

Private Sub cmbClose_Click()
Unload Me
End Sub


When I run the code, it gives me a "runtime error "13" mismatch error message and when I step into the code, it seemingly hangs up at the line in red above. After 2 full days and much research, I don't know how to solve the issue.

Can anybody help? Thanks.