Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 30
Default Excel export to Outlook:- Missing Microsoft Outlook 16.0 object library

Help please!

Using assistance from online resources I have VBA to create an Outlook contact from an Excel spreadsheet. I was told the machines it was to work on were Office 2016, the same as I use. When I took the macros on-site they use Outlook 2016 but Excel 2013; although one machine is all Office 2016. The macro worked on the "all office 2016" machine but gave an error of "Missing Microsoft Outlook 16.0 object library."

I know I should use Late Binding for this, but can't get it to work/am not experienced enough. Having done extensive searches I found the article below (in quotes) and am wondering if I can take the file WITHOUT THE VBA in it to an Outlook 2013 machine, go into VBA Editor, check the Outlook 15.0 Library reference, paste in the VBA, save the document, then run the macro, it will have the correct DLL referred?


This is an extract from the article that prompted this question:-
"One way to deal with this is to create and save the workbook using the earlier version of Excel. When it is opened in the later version of Excel, the reference to the VBA library will be automatically updated. Excel does the updates going to later versions, but it doesn't do them going to earlier versions.

This means, however, that even if the workbook is created in the earlier version of Excel, once it is opened and subsequently saved in the later version of Excel, users of the earlier version will have problems opening it."


THE VBA CODE
Sub ExcelWorksheetDataAddToOutlookContacts1()
Application.ScreenUpdating = False

If MsgBox("Have you checked if this client has an existing record with us?", vbQuestion + vbYesNo, "Input Question") < vbYes Then

Exit Sub

End If


'Automating Outlook from Excel: This example uses the Application.CreateItem Method to export data from an Excel Worksheet to the default Contacts folder.
'Automate using Early Binding: Add a reference to the Outlook Object Library in Excel (your host application) by clicking Tools-References in VBE, which will enable using Outlook's predefined constants. Once this reference is added, a new instance of Outlook application can be created by using the New keyword.

'Ensure that the worksheet data to be posted to Outlook, starts from row number 2:

'Ensure corresponding columns of data in the Worksheet, as they will be posted in the Outlook Contacts Folder:
'Column A: First Name
'Column B: Last Name
'Column C: Email Address
'Column D: Company Name
'Column E: Mobile Telephone Number

Dim applOutlook As Outlook.Application
Dim nsOutlook As Outlook.Namespace
Dim ciOutlook As Outlook.ContactItem
Dim delFolder As Outlook.folder
Dim delItems As Outlook.Items
Dim lLastRow As Long, i As Long, n As Long, c As Long


'determine last data row in the worksheet:
lLastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

'Create a new instance of the Outlook application. Set the Application object as follows:
Set applOutlook = New Outlook.Application

'use the GetNameSpace method to instantiate (ie. create an instance) a NameSpace object variable, to access existing Outlook items. Set the NameSpace object as follows:
Set nsOutlook = applOutlook.GetNamespace("MAPI")

'----------------------------
'Empty the Deleted Items folder in Outlook so that when you quit the Outlook application you bypass the prompt: Are you sure you want to permanently delete all the items and subfolders in the "Deleted Items" folder?

'set the default Deleted Items folder:
Set delFolder = nsOutlook.GetDefaultFolder(olFolderDeletedItems)
'set the items collection:
Set delItems = delFolder.Items

'determine number of items in the collection:
c = delItems.Count
'start deleting from the last item:
For n = c To 1 Step -1
delItems(n).Delete
Next n
'----------------------------

'post each row's data on a separate contact item form:
For i = 2 To lLastRow
'Use the Application.CreateItem Method to create a new contact Outlook item in the default Contacts folder. Using this method a new contact item is always created in the default Contacts folder.
'create and display a new contact form for input:
Set ciOutlook = applOutlook.CreateItem(olContactItem)
'display the new contact item form:
ciOutlook.Display
'set properties of the new contact item:
With ciOutlook
..firstName = Sheets("Sheet1").Cells(i, 1)
..LastName = Sheets("Sheet1").Cells(i, 2)
..JobTitle = Sheets("Sheet1").Cells(i, 3)
..Email1Address = Sheets("Sheet1").Cells(i, 4)
..CompanyName = Sheets("Sheet1").Cells(i, 5)
..BusinessTelephoneNumber = Sheets("Sheet1").Cells(i, 7)
..HomeTelephoneNumber = Sheets("Sheet1").Cells(i, 6)
..MobileTelephoneNumber = Sheets("Sheet1").Cells(i, 8)
..HomeAddress = Sheets("Sheet1").Cells(i, 9)
..Body = Sheets("Sheet1").Cells(i, 10)
End With
'close the new contact item form after saving:
ciOutlook.Close olSave
Next i

'quit the Oulook application:
'applOutlook.Quit

'clear the variables:
Set applOutlook = Nothing
Set nsOutlook = Nothing
Set ciOutlook = Nothing
Set delFolder = Nothing
Set delItems = Nothing

MsgBox "Check in Outlook Contacts to make sure the record is created correctly", vbOK, "Question"

Application.ScreenUpdating = True
End Sub
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,182
Default Excel export to Outlook:- Missing Microsoft Outlook 16.0 object library

The problem is that MS forces Outlook to the current/latest MSO install
version. OK if you use early binding for development (if needed) but
better you switch to late binding before you distribute your project...

Check if outlook is running 1st: (It doesn't allow multiple instances)

Private Function bOutlookAvailable() As Boolean
Dim appOL As Object, bWasRunning As Boolean

' Attempt to get a reference to a currently open
' instance of Outlook.
On Error Resume Next
Set appOL = GetObject(, "Outlook.Application")
' If this fails, attempt to start a new instance.
If appOL Is Nothing Then
Set appOL = CreateObject("Outlook.Application")
Else
' Otherwise flag that Outlook was already running
' so that we don't try to close it.
bWasRunning = True
End If
On Error GoTo 0

' Return the result of the test.
If Not appOL Is Nothing Then
' If we started Outlook we need to close it.
If Not bWasRunning Then appOL.Quit
Set appOL = Nothing: bOutlookAvailable = True
Else
bOutlookAvailable = False
End If
End Function 'bOutlookAvailable

You could modify it to leave the CreateObject instance running, but be
careful to also check bWasRunning to see if you should close it. Now
your code should ref whatever version is on the host machine. I suggest
using a global var for this...

Public gbOutlookIsRunning As Boolean

...and use it to test after you put the local in it...

<snip
' Return the result of the test.
If Not olApp Is Nothing Then
' If we started Outlook we need to close it.
If Not bWasRunning Then olApp.Quit
Set olApp = Nothing: bOutlookAvailable = True
Else
bOutlookAvailable = False
End If
gbOutlookIsRunning = bWasRunning
End Function 'bOutlookAvailable

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default Excel export to Outlook:- Missing Microsoft Outlook 16.0 object library

Thanks, I'll try 2mo & report back
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 30
Default Excel export to Outlook:- Missing Microsoft Outlook 16.0 object library

Hi Garry

thanks for this. I've included the code you posted; I hope I've done it correctly (I've put all my vba below this message). It works fine on my pc but I won't get a chance to try it on the user's pc until later.

Am I understanding this right, by incorporating the code you posted my "code should ref whatever version is on the host machine." ?

Thanks again!

Steve

Public gbOutlookIsRunning As Boolean

Private Function bOutlookAvailable() As Boolean
Dim appOL As Object, bWasRunning As Boolean

' Attempt to get a reference to a currently open
' instance of Outlook.
On Error Resume Next
Set appOL = GetObject(, "Outlook.Application")
' If this fails, attempt to start a new instance.
If appOL Is Nothing Then
Set appOL = CreateObject("Outlook.Application")
Else
' Otherwise flag that Outlook was already running
' so that we don't try to close it.
bWasRunning = True
End If
On Error GoTo 0

' Return the result of the test.
If Not appOL Is Nothing Then
' If we started Outlook we need to close it.
If Not bWasRunning Then appOL.Quit
Set appOL = Nothing: bOutlookAvailable = True
Else
bOutlookAvailable = False
End If
gbOutlookIsRunning = bWasRunning
End Function 'bOutlookAvailable

Sub ExcelWorksheetDataAddToOutlookContacts1()

Application.ScreenUpdating = False

If MsgBox("Have you checked if this client has an existing record with us?", vbQuestion + vbYesNo, "MOAIFA Question") < vbYes Then

Exit Sub

End If

' Test if Outlook is running
Call bOutlookAvailable


'Automating Outlook from Excel: This example uses the Application.CreateItem Method to export data from an Excel Worksheet to the default Contacts folder.
'Automate using Early Binding: Add a reference to the Outlook Object Library in Excel (your host application) by clicking Tools-References in VBE, which will enable using Outlook's predefined constants. Once this reference is added, a new instance of Outlook application can be created by using the New keyword.

'Ensure that the worksheet data to be posted to Outlook, starts from row number 2:

'Ensure corresponding columns of data in the Worksheet, as they will be posted in the Outlook Contacts Folder:
'Column A: First Name
'Column B: Last Name
'Column C: Email Address
'Column D: Company Name
'Column E: Mobile Telephone Number

Dim applOutlook As Outlook.Application
Dim nsOutlook As Outlook.Namespace
Dim ciOutlook As Outlook.ContactItem
Dim delFolder As Outlook.folder
Dim delItems As Outlook.Items
Dim lLastRow As Long, i As Long, n As Long, c As Long

'determine last data row in the worksheet:
lLastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

'Create a new instance of the Outlook application. Set the Application object as follows:
Set applOutlook = New Outlook.Application

'use the GetNameSpace method to instantiate (ie. create an instance) a NameSpace object variable, to access existing Outlook items. Set the NameSpace object as follows:
Set nsOutlook = applOutlook.GetNamespace("MAPI")

'----------------------------
'Empty the Deleted Items folder in Outlook so that when you quit the Outlook application you bypass the prompt: Are you sure you want to permanently delete all the items and subfolders in the "Deleted Items" folder?

'set the default Deleted Items folder:
Set delFolder = nsOutlook.GetDefaultFolder(olFolderDeletedItems)
'set the items collection:
Set delItems = delFolder.Items

'determine number of items in the collection:
c = delItems.Count
'start deleting from the last item:
For n = c To 1 Step -1
delItems(n).Delete
Next n
'----------------------------

'post each row's data on a separate contact item form:
For i = 2 To lLastRow
'Use the Application.CreateItem Method to create a new contact Outlook item in the default Contacts folder. Using this method a new contact item is always created in the default Contacts folder.
'create and display a new contact form for input:
Set ciOutlook = applOutlook.CreateItem(olContactItem)
'display the new contact item form:
ciOutlook.Display
'set properties of the new contact item:
With ciOutlook
..firstName = Sheets("Sheet1").Cells(i, 1)
..LastName = Sheets("Sheet1").Cells(i, 2)
..JobTitle = Sheets("Sheet1").Cells(i, 3)
..Email1Address = Sheets("Sheet1").Cells(i, 4)
..CompanyName = Sheets("Sheet1").Cells(i, 5)
..BusinessTelephoneNumber = Sheets("Sheet1").Cells(i, 7)
..HomeTelephoneNumber = Sheets("Sheet1").Cells(i, 6)
..MobileTelephoneNumber = Sheets("Sheet1").Cells(i, 8)
..HomeAddress = Sheets("Sheet1").Cells(i, 9)
..Body = Sheets("Sheet1").Cells(i, 10)
End With
'close the new contact item form after saving:
ciOutlook.Close olSave
Next i

'quit the Oulook application:
'applOutlook.Quit

'clear the variables:
Set applOutlook = Nothing
Set nsOutlook = Nothing
Set ciOutlook = Nothing
Set delFolder = Nothing
Set delItems = Nothing

MsgBox "Check in Outlook Contacts to make sure the record is created corretly", vbOK, "MOAIFA Question"

Application.ScreenUpdating = True
End Sub
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,182
Default Excel export to Outlook:- Missing Microsoft Outlook 16.0 object library

This...

Sub ExcelWorksheetDataAddToOutlookContacts1()

...still uses early binding and so doesn't fix the problem. You have to
remove the reference to Outlook and change the code so it uses
GetObject to ref the existing instance (if gbOutlookIsRunning) or uses
CreateObject (if not gbOutlookIsRunning) to start Outlook. If you start
Outlook remember to close it when your task is done!

<air code
Dim appOL As Object

If bOutlookAvailable Then
If gbOutlookIsRunning Then
Set appOL = GetObject(, "Outlook.Application")
Else
Set appOL = CreateObject("Outlook.Application")
End If 'gbOutlookIsRunning
End If 'bOutlookAvailable

With appOL
'//do your task...

End With 'appOL

Cleanup:
'Close Outlook if wasn't running
If Not gbOutlookIsRunning Then appOL.Quit
Set appOL = Nothing

--
Garry

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


  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,182
Default Excel export to Outlook:- Missing Microsoft Outlook 16.0 object library

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
  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,182
Default Excel export to Outlook:- Missing Microsoft Outlook 16.0 object library

Typo correction...

Const ContactItem& = .OlItemType.olContactItem '2

Also.., you could create/use a single instance of the dialog and just
..Save each ContactItem, then reload the props with the next record.
This way you don't have to use a new form for each entry...

<snip
'Post each row's data
Set vItem = .CreateItem(ContactItem)
With vItem
.Display
For n = 2 To lLastRow
.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)
.Save
Next 'n
.Close
End With 'vItem
</snip

Also.., if you don't display the dialog you could take advantage of
turning ScreenUpdating off since the hidden form won't have to
redraw/refresh for each record.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,182
Default Excel export to Outlook:- Missing Microsoft Outlook 16.0 object library

Another optimized approach; -instead of reading each cell read from
memory!

<aircode
Sub AddContacts_Outlook2()
Dim appOL As Object, wsSrc As Worksheet, vNamespace, vFolder, vItem,
vData
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 '2
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
Set vItem = .CreateItem(ContactItem)
vData = Range(Cells(2, 1), Cells(lLastRow, 10))
With vItem
.Display
For n = LBound(vData) To UBound(vData)
.FirstName = vData(n, 1): .LastName = vData(n, 2)

.CompanyName = vData(n, 5): .JobTitle = vData(n, 3)
.BusinessTelephoneNumber = vData(n, 7)

.EmailAddress = vData(n, 4): .HomeAddress = vData(n, 9)
.HomeTelephoneNumber = vData(n, 6)
.MobileTelephoneNumber = vData(n, 8)

.Body = vData(n, 10): .Save
Next 'n
.Close
End With 'vItem
End With 'appOL

Cleanup:
'Close Outlook if wasn't running
If Not gbOutlookIsRunning Then appOL.Quit
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
  #10   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,182
Default Excel export to Outlook:- Missing Microsoft Outlook 16.0 object library

I forgot to delete...

.Display

--
Garry

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


  #11   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,182
Default Excel export to Outlook:- Missing Microsoft Outlook 16.0 object library

Here's what I suggest...

A well constructed/designed datasheet follows database Best Practices
and Principles. That said, your source datatable (worksheet or text
file) should be structured as follows:

1. The table should contain contiguous records; -no blanks between
1st row and last record.

2. The 1st row/line should *always* contain Fieldnames for the
underlying data.

3. In the case where source data is on a worksheet, the UsedRange
should not extend beyond the last field column or last record row.

You can very this using the keyboard combo *Ctrl+End* to move
selection to locate tha last 'used' cell on the sheet. Delete any
rows/cols beyond your datatable and *Save* the file. Using the
keyboard combo again should now locate the last cell in your
datatable, making it comply with database convention for
good datatable design.

4. In the case where source data is in a text file:
- The 1st line contains a delimited list of fieldnames;
- The underlying records contain delimited data that corresponds
to the fieldnames;
- The file contains no blank lines so that when you use the
keyboard combo *Ctrl+End* the carat is at the end of the last
record.

I don't use Outlook and so my familiarity with it is minimal! Because I
normally code to use whatever the default mail app is, I'm forced to be
somewhat fluent in how the popular mail apps work from a programming
perspective. Thus the AddContacts_Outlook() routine differs from say
the AddContacts_Tbird() routine. Personally, I prefer to read/write the
app's contacts file[s] directly rather than automate the app and do it
as you are here. (All mail apps support importing/exporting contacts
and so the source files are available to us!)

I also use a common Enum for Fieldnames so all are in the same location
in my tables and recordsets.

Following is my version of approaching your task via automation. It's
based on the datatable meeting database convention as described above.
Normally I read the contacts file into an arraym edit, then write the
array back to the file. In your case of source data being on a
worksheet, the procedure is named "AddContacts_Outlook2" because coding
is different.


Option Explicit
Option Base 1

Public gbOutlookRunning As Boolean

Enum ContactInfo
FirstName = 1
LastName
Email
Company
Title
CompanyAddr
CompanyPh
CompanyFax
HomeAddr
HomePh
CellPh
AltPh
Notes
End Enum
' **The above Enum contains the most common contact info my users
' record. Adjust to suit your 10-field table by deleting unused fields.


Sub AddContacts_Outlook2()
Dim appOL As Object, vNamespace, vFolder, vItem, vData, n&

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

On Error GoTo Cleanup
With appOL
Const DeletedItems& = .OlDefaultFolders.olFolderDeletedItems '3
Const ContactItem& = .OlItemType.olContactItem '2
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

'Add Contact data
vData = ActiveSheet.UsedRange
Set vItem = .CreateItem(ContactItem)
With vItem
For n = 2 To UBound(vData) '//excludes fieldnames
.FirstName = vData(n, ContactInfo.FirstName)
.LastName = vData(n, ContactInfo.LastName)

.CompanyName = vData(n, ContactInfo.Company)
.JobTitle = vData(n, ContactInfo.Title)
.BusinessTelephoneNumber = vData(n, ContactInfo.CompanyPh)

.EmailAddress = vData(n, ContactInfo.Email)
.HomeAddress = vData(n, ContactInfo.HomeAddr)
.HomeTelephoneNumber = vData(n, ContactInfo.HomePh)
.MobileTelephoneNumber = vData(n, ContactInfo.CellPh)

.Body = vData(n, ContactInfo.Notes)
.Save
Next 'n
.Close
End With 'vItem
End With 'appOL


Cleanup:
'Close Outlook if wasn't running
If Not gbOutlookRunning Then appOL.Quit
Set appOL = Nothing: Set vNamespace = Nothing
Set vFolder = Nothing: Set vItem = Nothing

If Err < 0 Then
MsgBox "An error occured trying to add contact info!", vbCritical
End If
End Sub 'AddContacts_Outlook2

Private Function bOutlookAvailable() As Boolean
Dim appOL As Object, bWasRunning As Boolean

' Attempt to get a reference to a currently open
' instance of Outlook.
On Error Resume Next
Set appOL = GetObject(, "Outlook.Application")
' If this fails, attempt to start a new instance.
If appOL Is Nothing Then
Set appOL = CreateObject("Outlook.Application")
Else
' Otherwise flag that Outlook was already running
' so that we don't try to close it.
bWasRunning = True
End If
On Error GoTo 0

' Return the result of the test.
If Not appOL Is Nothing Then
' If we started Outlook we need to close it.
If Not bWasRunning Then appOL.Quit
Set appOL = Nothing: bOutlookAvailable = True
Else
bOutlookAvailable = False
End If
End Function 'bOutlookAvailable

--
Garry

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

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Selecting correct MS Outlook Object Library (repeat) Pete[_22_] Excel Programming 4 October 20th 07 04:49 PM
Selecting correct MS Outlook Object Library Pete[_22_] Excel Programming 1 October 17th 07 09:24 AM
Microsoft Outlook Library splodgey Excel Discussion (Misc queries) 2 August 9th 07 03:58 PM
Microsoft Word Object Library in Excel Gaetan Excel Discussion (Misc queries) 4 March 14th 07 07:34 PM
Outlook 11 Outlook 10 Object Library Compatibility Issues Paul Mac[_4_] Excel Programming 11 May 19th 06 04:27 AM


All times are GMT +1. The time now is 02:00 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"