Hi Steven,

Am Fri, 24 Feb 2017 06:36:53 -0800 (PST) schrieb :

olFolder, olContactItem and so on are Outlook keywords. They only
work correct when you have set a reference to Microsoft Outlook xx.0
Object Library.
Set the Outlook App. Then you can check the version of the app and
set the expected reference:

Dim appOL As Object
Dim objVBE As Object
Dim strOff As String

Set appOL = GetObject(, "Outlook.Application")
If appOL Is Nothing Then Set appOL =
CreateObject("Outlook.Application")

Set objVBE = Application.VBE.ActiveVBProject.References
On Error Resume Next

strOff = "Office" & Left(appOL.Version, 2)
'Modify the path to the MSOUTL.OLB
objVBE.AddFromFile "C:\Program Files (x86)\Microsoft Office\root\" &
strOff & "\MSOUTL.OLB"

'Your Code


Regards
Claus B.

The plan is to obviate need for the ref to the OLB via using late
binding. Once appOL is set all this will work on any machine with the
following changes...

<aircode:
Sub AddContacts_Outlook()
Dim appOL As Object, wsSrc As Worksheet, vNamespace, vFolder, vItem
Dim lLastRow&, n& 'Type Long

If bOutlookAvailable Then
If gbOutlookIsRunning Then
Set appOL = GetObject(, "Outlook.Application")
Else
Set appOL = CreateObject("Outlook.Application")
End If 'gbOutlookIsRunning
Else
MsgBox "This process requires MS Outlook be installed", vbCritical
Exit Sub
End If 'bOutlookAvailable

Set wsSrc = Sheets("Sheet1") '//assumes ActiveWorkbook
lLastRow = wsSrc.Cells(wksSrc.Rows.Count, 1).End(xlUp).Row

On Error GoTo Cleanup
With appOL
Const DeletedItems& = .OlDefaultFolders.olFolderDeletedItems '3
Const ContactItem& = .OlItemType.olContactItem '10
Const SaveItem& = .OlInspectorItem.olSave '0

Set vNamespace = .GetNamespace("MAPI")
Set vFolder = vNamespace.GetDefaultFolder(DeletedItems)
'Empty vFolder
For n = vFolder.Items.Count To 1 Step -1: vItems(n).Delete: Next 'n

'Post each row's data on a separate contact item form
For n = 2 To lLastRow
Set vItem = .CreateItem(ContactItem)
With vItem
.Display
.FirstName = wsSrc.Cells(n, 1)
.LastName = wsSrc.Cells(n, 2)
.JobTitle = wsSrc.Cells(n, 3)
.EmailAddress = wsSrc.Cells(n, 4)
.CompanyName = wsSrc.Cells(n, 5)
.BusinessTelephoneNumber = wsSrc.Cells(n, 7)
.HomeTelephoneNumber = wsSrc.Cells(n, 6)
.MobileTelephoneNumber = wsSrc.Cells(n, 8)
.HomeAddress = wsSrc.Cells(n, 9)
.Body = wsSrc.Cells(n, 10)
.Close SaveItem
End With 'vItem
Next 'n

End With 'appOL

Cleanup:
'Close Outlook if wasn't running
If Not gbOutlookIsRunning Then appOL.Quit
'Release memory
Set appOL = Nothing: Set wsSrc = Nothing
Set vNamespace = Nothing, Set vFolder = Nothing, Set vItem = Nothing

End Sub 'AddContacts_Outlook

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion