View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.programming
GS[_6_] GS[_6_] is offline
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