This message is in MIME format. Since your mail reader does not understand
this format, some or all of this message may not be legible.

------_=_NextPart_001_01C16873.70CA7A10
Content-Type: text/plain;
	charset="iso-8859-1"

Dane,  sorry I don't have time to sift through this code, but if you scroll
down about half way, you will see where the Outlook Contact is pulled....
 
Option Explicit
'modFaxToContact
'VBA module created for Outlook
'to be added to thisOutlookSession
'DAK - 08/08/01
'DAK - Per customer meeting, remove all template bookmarks except Name &
Date
'      leave template information on bottom for customer to fill in.
'DAK - 09-25-01
'DAK - Per Liz, add back bookmark for Contact Phone and Contact Fax
'DAK - 09-28-01
'DAK - moved the database back to [Global Address List]
'
'PROJECT REFERENCES
'   MS ADO 2.5
'   MS Word
'   MS Outlook
'   MS Office
 
'Outlook Variables for Command Bar
Dim objOutlook As Outlook.Application
Dim objExplorer As Outlook.Explorer
Dim objNS As Outlook.NameSpace
Dim contactFolder As Outlook.MAPIFolder
Dim objBar As Office.CommandBar
Dim objControl As Office.CommandBarControl
Dim objActionControl As Office.CommandBarControl
Dim objButton As Office.CommandBarControl
Dim objFaxButton As Office.CommandBarButton
Dim objExists As Boolean
 
'Outlook Variables for Fax Doc
Dim objSelected As Outlook.Selection
Dim objItems As Outlook.Items
Dim objItem As Outlook.ContactItem
Public outlookUser As String
 
'Word Variables
Dim objWord As Word.Application
Dim objDoc As Word.Document
 
'Word Template Variables
Dim contactFullName As String, contactFax As String, contactPhone As String
Dim senderFullName As String, senderTitle As String, senderPhone As String
Dim senderFax As String, senderEmail As String, senderDepartment As String
 
'Bookmark variables
'c = contact    s = sender
Dim cBookmarkFullName As String, cBookmarkFax As String, cBookmarkPhone As
String
Dim sBookmarkFullName1 As String, sBookmarkFullName2 As String,
sBookmarkTitle As String
Dim sBookmarkPhone As String, sBookmarkFax As String, sBookmarkEmail As
String
Dim sBookmarkDepartment As String
 
'FILPHONE database ADO connection variables
Dim objConn As New ADODB.Connection
Dim objRS As New ADODB.Recordset
Dim objRS_2 As New ADODB.Recordset
Dim objCmd As New ADODB.Command
Dim strConnection As String
Dim strSQL As String
 
'Variables to fill Word Doc
Dim strRSname As String, strRStitle As String, strRSphone As String,
strRSDept As String
Dim strRSfax As String, strRSemail As String
 
'Variables to create Email Address
Dim strLen As String, intPos As Integer, intStart As Integer
Dim intTotal As Integer, strFullEmail As String, strFullEmailAddress As
String
Private Function makeEmail(thisAddress As String)
On Error Resume Next
 
    'strLen = Len(thisAddress)
    'intPos = InStrRev(thisAddress, "/")
    'intStart = intPos + 4
    'intTotal = strLen - intPos
    'strFullEmail = Mid(thisAddress, intStart, intTotal)
    strFullEmailAddress = thisAddress & "@fmtinv.com"
    
    makeEmail = strFullEmailAddress
    
End Function
 
Public Sub FaxToContact()
On Error Resume Next
 
'INSTANCIATE OBJECTS
 
Set objOutlook = New Outlook.Application
    If objOutlook Is Nothing Then
        Set objOutlook = CreateObject("Outlook.Application")
    End If
 
Set objNS = objOutlook.GetNamespace("MAPI")
outlookUser = objNS.CurrentUser
'Debug.Print outlookUser
 
'CODE TO CHECK IF WORD IS OPEN
If objWord Is Nothing Then
    Set objWord = New Word.Application
End If
 
'OPEN WORD
If objDoc Is Nothing Then
 
'**HELP DESK**
    Set objDoc = objWord.Documents.Add("C:\Program Files\Microsoft
Office\Templates\1033\Fax Cover.dot")
End If
 
'THIS SECTION GETS THE CONTACT SELECTION
Set objSelected = objOutlook.ActiveExplorer.Selection
    If objSelected.Count <> 1 Then
        MsgBox "Please select a Contact", vbOKOnly, "Fax to Contact"
        Exit Sub
    End If
 
Set objItem = objSelected.Item(objSelected.Count)
 
'------- CREATE FAX SECTION
------------------------------------------------------------
 
'CREATE CONNECTION STRING FOR DSNLESS CONNECTION
strConnection = "Provider=SQLOLEDB;UID=Phone;PWD=FILPHONE;" & _
                "Data Source=CLUSQL01;Database=FILPHONE;" & _
                "Persist Security Info=true"
                
objConn.Open (strConnection)
 
'-------------THIS SECTION GETS THE SENDER'S FAX & EMAIL
    strSQL = "SELECT [Fax Number], [Alias] FROM faxEmail_tbl WHERE
formal_name LIKE '" & outlookUser & "'"
    
    objRS.Open strSQL, objConn
       
        strRSfax = Trim(objRS("Fax Number"))
        strRSemail = Trim(objRS("Alias"))
            'MAKEEMAIL STRIPS THE EXCHANGE EMAIL ADDRESS AND FORMATS IT
            strRSemail = makeEmail(strRSemail)
        
'-------------THIS SECTION GETS THE SENDER'S NAME,TITLE,PHONE,EMAIL
strSQL = "SELECT * FROM [Global Address List] WHERE formal_name = '" &
outlookUser & "'"
 
objRS_2.Open strSQL, objConn, adOpenForwardOnly, adLockOptimistic
 
    If Not objRS_2.BOF Or Not objRS_2.EOF Then
            strRSname = Trim(objRS_2("formal_name"))
            strRStitle = Trim(objRS_2("Job Name"))
            strRSphone = Trim(objRS_2("Work Telephone"))
            strRSDept = Trim(objRS_2("Department"))
                Else
                    objRS_2.Close
                    objRS_2.Source = "SELECT * FROM [Global Address List]
WHERE common_name = '" & outlookUser & "'"
                    objRS_2.Open
                        If Not objRS_2.BOF Or Not objRS_2.EOF Then
                                strRSname = Trim(objRS_2("common_name"))
                                strRStitle = Trim(objRS_2("Job Name"))
                                strRSphone = Trim(objRS_2("Work Telephone"))
                                strRSDept = Trim(objRS_2("Department"))
 
                                    Else
                                        MsgBox "Cannot find Sender's
information in database"
                                        Exit Sub
                         End If
    End If
        
        
    'Fill Document Merge Variables from Selected Contact
    'contact info - these values come out of User's Outlook
    'in Public Folders under Commercial/Master Contact List
        contactFullName = objItem.FullName
        contactFax = objItem.BusinessFaxNumber
        contactPhone = objItem.BusinessTelephoneNumber
                      
    'sender info - these values come out of FILPHONE database (SQL)
        senderFullName = strRSname
        senderTitle = strRStitle
        senderPhone = strRSphone
        senderFax = strRSfax
        senderEmail = strRSemail
        senderDepartment = strRSDept
                                                           
    'Fill Bookmarks  ----> THIS CODE WORKS ----
 
    cBookmarkFullName = "cFullName"
    cBookmarkFax = "cFax"
    cBookmarkPhone = "cPhone"
    sBookmarkFullName1 = "sFullName_1"
    sBookmarkFullName2 = "sFullName_2"
    sBookmarkTitle = "sTitle"
    sBookmarkPhone = "sPhone"
    sBookmarkFax = "sFax"
    sBookmarkEmail = "sEmail"
    sBookmarkDepartment = "sDept"
    
    With Selection.Font
        .Name = "Arial"
        .Size = "10"
        .Bold = True
    End With
        
    objDoc.Bookmarks(cBookmarkFullName).Range.Text = contactFullName
    objDoc.Bookmarks(cBookmarkFax).Range.Text = contactFax
    objDoc.Bookmarks(cBookmarkPhone).Range.Text = contactPhone
    objDoc.Bookmarks(sBookmarkFullName1).Range.Text = senderFullName
    objDoc.Bookmarks(sBookmarkFullName2).Range.Text = senderFullName
    objDoc.Bookmarks(sBookmarkTitle).Range.Text = senderTitle
    objDoc.Bookmarks(sBookmarkDepartment).Range.Text = senderDepartment
    objDoc.Bookmarks(sBookmarkPhone).Range.Text = senderPhone
    objDoc.Bookmarks(sBookmarkFax).Range.Text = senderFax
    objDoc.Bookmarks(sBookmarkEmail).Range.Text = senderEmail
            
    'Turn off Bookmarks and display document
    objDoc.Activate
    objDoc.ActiveWindow.View.ShowBookmarks = False
    objWord.Visible = True
    objDoc.ActiveWindow.Visible = True
 
          
'DESTROY OBJECTS
Set objOutlook = Nothing
Set objExplorer = Nothing
Set objWord = Nothing
Set objDoc = Nothing
Set objItem = Nothing
Set contactFolder = Nothing
Set objNS = Nothing
Set objConn = Nothing
Set objRS = Nothing
Set objRS_2 = Nothing
Set objCmd = Nothing
 
Set objBar = Nothing
Set objControl = Nothing
Set objActionControl = Nothing
Set objButton = Nothing
Set objFaxButton = Nothing
 
End Sub
 
 
 
 
 
 
 
 
 
 

-----Original Message-----
From: Zadoyen, Eva [mailto:EZadoyen@s...]
Sent: Thursday, November 08, 2001 7:29 AM
To: professional vb
Subject: [pro_vb] RE: Outlook Contacts


Dane, 
There is a book "CDO and MAPI Programming with Visual Basic - Developing
Mail and Messaging Applications"
This link   http://www.oreilly.com/catalog/cdomapi/chapter/ch07.html
<http://www.oreilly.com/catalog/cdomapi/chapter/ch07.html>   is the best (
for me at least ) for CDO understanding and implementing.

There is a whole section "Working with Address Books" that will give you
some insight.
I personally didn't work with Address Books but I used the other part of
this chapter  to create my application and it was invaluable help.
 
    Good luck.
    Eva
 
 -----Original Message-----
From: Charlton, Dane [mailto:DCharlton@a...]
Sent: Wednesday, November 07, 2001 4:04 PM
To: professional vb
Subject: [pro_vb] RE: Outlook Contacts



I need to retrieve and set properties of contacts in the public folders.  Do
you treat contacts as messages? how do you define the variable to use for a
contact if not 'as MAPI.message'

-----Original Message-----
From: Zadoyen, Eva [mailto:EZadoyen@s...] 
Sent: Tuesday, November 06, 2001 2:32 PM
To: professional vb
Subject: [pro_vb] RE: Outlook Contacts


Dane,
I'm not sure what are you looking for - Why you are not using Outlook object
for this purpose if you have an Outlook ?
I have CDO application to sent messages but no Outlook on the server where
it installed.
If this is what you are looking for  - let me know.
    Eva

-----Original Message-----
From: Charlton, Dane [mailto:DCharlton@a...]
Sent: Tuesday, November 06, 2001 1:10 PM
To: professional vb
Subject: [pro_vb] Outlook Contacts



How do I get the contacts properties using vb and cdo?  The normal message
properties don't seem to work. 

Dane Charlton 
System Engineer 
CNE, MCSE+I, MCDBA 
557 East Tallmadge Ave. 
Akron, Ohio 44310 
dcharlton@a...