Contact Page 2 Combobox via Registry

[bnj1776]

Hello,

Overview: I'm working to select a contact from Outlook that is marked as a "Customer" for use in an Excel process to build an estimate or one marked as "Vendor" to build a purchase order. (We have all of the contact information in Outlook so we want to use it, not have to reenter/maintain in Excel too.)

Below is the test code that I've managed to put together so far (it is not clean and neat yet).

Step 1: Using Excel to create/maintain a "Contact Type" list which is then exported to the HKEY_CURRENT_USER\Software\VB and VBA Program Settings\Estimator\Settings registry.

Step 2: Using Outlook custom Contact form (p.2) to select the "Contact Type" (Vendor, Contractor, Customer, etc)

Step 3: Using Excel to build an estimate, but the first step involves selecting a "Customer" or "Vendor" from Outlook search form to pull back the email address. Plan to use that email address to then fetch the rest of the Contact's information to populate Excel (see test code to fill worksheet with contact info below).

Issues I need help with currently:

1. The value is not being saved once chosen? Or it may be that it is getting deleted by my code (more likely), I just am not finding the right way to keep it yet. If I select "Customer" for a contact, close the contact window and reopen that contact, it is back to blank.

2. When I try to save the customized contact form via File, Save As the window does not open to allow me to type in the file name. http://msdn.microsoft.com/en-us/library/office/ff865673(v=office.15).aspx
Right now I only see to be able to get the custom contact form working for one contact. What do I need to do to get the custom form working for all contacts?

OR... am I nuts and need to do this some other way??? What would you suggest???

Thank you,
Brian

 

[bnj1776]

Registry Values (array via comma separated values) :

ContactTypeCount
REG_SZ
3

ContactTypeName
REG_SZ
Vendor, Contractor, Customer

ContactTypeDescription
REG_SZ
Vendor/Supplier, Contractor, Owner

VBScript in the Contact form:

Sub Item_Open()

    Const HKEY_CURRENT_USER = &H80000001
    Const strComputer = "."

    Dim RegistryPath
    Dim RegistryKey
    Dim ContactTypeCountKey
    Dim ContactTypeNameKey
    Dim ContactTypeDescriptionKey

    Dim oReg

    Dim ContactTypeCount
    Dim ContactTypeName
    Dim ContactTypeDescription
    Dim lRow

    Dim TempString

    Dim ContactType()

    Dim FormPage
    Dim Control

    RegistryPath = "Software\VB and VBA Program Settings\Estimator\Settings"

    Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")

    RegistryKey = "ContactTypeCount"
    oReg.GetStringValue HKEY_CURRENT_USER, RegistryPath, RegistryKey, ContactTypeCount
    ReDim ContactTypeName(ContactTypeCount - 1) 'Split uses zero
    ReDim ContactTypeDescription(ContactTypeCount - 1) 'Split uses zero

    RegistryKey = "ContactTypeName"
    oReg.GetStringValue HKEY_CURRENT_USER, RegistryPath, RegistryKey, TempString
    ContactTypeName = Split(TempString, ",")

    RegistryKey = "ContactTypeDescription"
    oReg.GetStringValue HKEY_CURRENT_USER, RegistryPath, RegistryKey, TempString
    ContactTypeDescription = Split(TempString, ",")

    ReDim ContactType(ContactTypeCount - 1, 2)

    TempString = vbNullString

    For lRow = LBound(ContactTypeName) To UBound(ContactTypeName)
      TempString = TempString & Trim(ContactTypeName(lRow))
          If Trim(ContactTypeName(lRow)) <> Trim(ContactTypeDescription(lRow)) And _
            Trim(ContactTypeDescription(lRow)) <> vbNullString Then
              TempString = TempString & " (" & Trim(ContactTypeDescription(lRow)) & ")"
        End If
        If lRow < UBound(ContactTypeName) Then
        TempString = TempString & ";"
        End If
    Next

'   Sets the name of page on the form (P.2)
    Set FormPage = Item.GetInspector.ModifiedFormPages("P.2")

'   Sets Control to ContactTypeComboBox
    Set Control = FormPage.Controls("ContactTypeComboBox")
    Control.ColumnCount = 1
    Control.PossibleValues() = TempString

End Sub

Excel code to write to the Registry

Option Explicit
Option Base 1

Sub testreg()
   
    Dim RegAppName As String
    Dim RegSection As String
    Dim RegKey As String
    Dim RegDefault As String
   
    Dim ContactType() As String
    Dim lRow As Long
    Dim lCol As Long
   
    Dim TempString As String
   
    RegAppName = "Estimator"
    RegSection = "Settings"
    RegKey = "ContactType"
    RegDefault = ""
   
   
    ReDim ContactType(1 To 3, 1 To 2)
   
    ContactType(1, 1) = "Vendor"
    ContactType(1, 2) = "Vendor/Supplier"
    ContactType(2, 1) = "Contractor"
    ContactType(2, 2) = "Contractor"
    ContactType(3, 1) = "Customer"
    ContactType(3, 2) = "Owner"
   
   
    SaveSetting RegAppName, RegSection, RegKey & "Count", UBound(ContactType, 1)
   
    TempString = vbNullString
    For lRow = 1 To UBound(ContactType, 1)
            TempString = TempString & ContactType(lRow, 1)
            If lRow < UBound(ContactType, 1) Then
                TempString = TempString & ", "
            End If
    Next lRow
    SaveSetting RegAppName, RegSection, RegKey & "Name", TempString

    TempString = vbNullString
    For lRow = 1 To UBound(ContactType, 1)
            TempString = TempString & ContactType(lRow, 2)
            If lRow < UBound(ContactType, 1) Then
                TempString = TempString & ", "
            End If
    Next lRow
    SaveSetting RegAppName, RegSection, RegKey & "Description", TempString

'    Debug.Print GetSetting(RegAppName, RegSection, RegKey, RegDefault)

End Sub

Excel code to fill worksheet from Outlook Contacts

Option Explicit

Sub Import_Contacts()

'   Outlook objects:
'       Dim olApp As Outlook.Application
        Dim olApp                           As Object
   
'       Dim olNamespace As Outlook.Namespace
        Dim olNamespace                     As Object
   
'       Dim olFolder As Outlook.MAPIFolder
        Dim olFolder                        As Object
   
'       Dim olConItems As Outlook.Items
        Dim olConItems                      As Object
        Const olFolderContacts              As Integer = 10 'Outlook's Enumeration for Contacts
  
'       Dim NewTask As Outlook.TaskItem
        Dim olTaskItem                      As Object
       
        Dim olItem                          As Object
   
'   Excel objects:
        Dim wbBook                          As Workbook
        Dim wsSheet                         As Worksheet
   
'       Location in the imported contact list
        Dim lnContactCount                  As Long
   
        Dim strDummy                        As String
   
'   Initalize the Outlook variables with the MAPI namespace and the default Outlook folder of the current user.
    Set olApp = CreateObject("Outlook.Application")
    Set olNamespace = olApp.GetNameSpace("MAPI")
    Set olFolder = olNamespace.GetDefaultFolder(olFolderContacts)
    Set olConItems = olFolder.items
   
'   Turn off screen updating
    Application.ScreenUpdating = False
   
'   Initialize the Excel objects
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets(1)
   
'   Format the target worksheet
    With wsSheet
        .Range("A1").CurrentRegion.Clear
        .Cells(1, 1).Value = "Company / Private Person"
        .Cells(1, 2).Value = "Street Address"
        .Cells(1, 3).Value = "Postal Code"
        .Cells(1, 4).Value = "City"
        .Cells(1, 5).Value = "Contact Person"
        .Cells(1, 6).Value = "E-mail"
        With .Range("A1:F1")
            .Font.Bold = True
            .Font.ColorIndex = 10
            .Font.Size = 11
        End With
    End With
   
    wsSheet.Activate
   
'    Set olApp = CreateObject("Outlook.Application")
'    Set olNamespace = olApp.GetNameSpace("MAPI")
'    Set olFolder = olNamespace.GetDefaultFolder(10)
'    Set olConItems = olFolder.items
           
'   Row number to place the new information on; starts at 2 to avoid overwriting the header
    lnContactCount = 2
   
'   For each contact: if it is a business contact, write out the business info in the Excel worksheet;
'   otherwise, write out the personal info.
    For Each olItem In olConItems
        If TypeName(olItem) = "ContactItem" Then
            With olItem
'                If InStr(olItem.CompanyName, strDummy) > 0 Then
                    Cells(lnContactCount, 1).Value = .CompanyName
                    Cells(lnContactCount, 2).Value = .BusinessAddressStreet
                    Cells(lnContactCount, 3).Value = .BusinessAddressPostalCode
                    Cells(lnContactCount, 4).Value = .BusinessAddressCity
                    Cells(lnContactCount, 5).Value = .FullName
                    Cells(lnContactCount, 6).Value = .Email1Address
'                Else
                    Cells(lnContactCount, 8).Value = .FullName
                    Cells(lnContactCount, 9).Value = .HomeAddressStreet
                    Cells(lnContactCount, 10).Value = .HomeAddressPostalCode
                    Cells(lnContactCount, 11).Value = .HomeAddressCity
                    Cells(lnContactCount, 12).Value = .FullName
                    Cells(lnContactCount, 13).Value = .Email1Address
                    Cells(lnContactCount, 14).Value = .User1
'                End If
'                wsSheet.Hyperlinks.Add Anchor:=Cells(lnContactCount, 6), _
'                                       Address:="mailto:" & Cells(lnContactCount, 6).Value, _
'                                       TextToDisplay:=Cells(lnContactCount, 6).Value
               
                Cells(lnContactCount, 7).Value = .LastModificationTime
           
                If .CustomerID = vbNullString Then
                    .CustomerID = lnContactCount
                End If
               
                On Error Resume Next
                .Save
           
            End With
            lnContactCount = lnContactCount + 1
        End If
    Next olItem
   
   
   
'   Null out the variables.
    Set olItem = Nothing
    Set olConItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
   
'   Sort the rows alphabetically using the CompanyName or FullName as appropriate, and then autofit.
    With wsSheet
        .Range("A2", Cells(2, 6).End(xlDown)).Sort key1:=Range("A2"), order1:=xlAscending
        .Range("A:F").EntireColumn.AutoFit
    End With
           
'   Turn screen updating back on.
    Application.ScreenUpdating = True
   
    MsgBox "The list has successfully been created!", vbInformation
   
End Sub

 

[Diane Poremsky]

I'm not sure I understand what you are saving to the registry or why you need to.

Field values not saving: Are you writing the values to a field in the contact form and saving the form?

File, Save as doesn't work to save templates and forms outside of Outlook. You need to publish the form and save it as form file.

 

[bnj1776]

We are trying to use a chosen individual's contact information which is stored in Outlook with our Excel process so that we do not have to reenter/maintain that same information in Excel each time we create a new estimate or generate a new purchase order.

We are using the registry to pass fairly static values between Excel and Outlook so as to "standardize" the Contact Type.
These would be our custom values "Customer, Vendor, etc" stored in "User Field 1" within Outlook.
And because we want to avoid hard coding the Contact Types in Outlook, we have an Excel sheet that can be updated which is automatically updating the registry values. This avoids having to sort out where different users may place their respective Outlook and Excel files so that information can be passed between the two.

-- If there is a better way to do this "process" please let me know

Regarding the p.2 field that is not saving, it is simply a combo list box that we are populating the possible values with via the registry (works). When the form opens, the initial value is blank and you can select any of the allowed values. But the statement to copy that combo list box value back to User Field 1 is not working and I don't understand why.

Function Item_Close()

    Dim FormPage
    Dim Control

'   Sets the name of page on the form (P.2)
    Set FormPage = Item.GetInspector.ModifiedFormPages("P.2")

'   Sets Control to ContactTypeComboBox
    Set Control = FormPage.Controls("ContactTypeComboBox")

    User1 = Control.Value

End Function

-- Is there some "save this now" code that is missing?

 

[Diane Poremsky]

So the registry is holding field values that fill in the dropdown or list controls, instead of using the Possible values field in the control's property? Using the registry might be the easiest.

You'd use Item.Save in the code before close closing the form.

 

[bnj1776]

Thank you Diane.
This part of the project is done.
Here is a copy of the Registry save code I'm using in Execl ...

Private Sub fmContactType_RegistrySave()
' Save Contact Type information to the Registry for use in Outlook

' Previously declared
'   Public Const sRegistry              As String = "HKEY_CURRENT_USER\Software\VB and VBA Program Settings\"
'   Public Const sRegistryAppName       As String = sTitle
'   Public Const sRegistrySection       As String = "Settings"
'   Public Const sRegistryKey           As String = "ContactType"
  
    Dim row_RegistrySave                As Long
    Dim lCount                          As Integer
  
    On Error Resume Next 'Skip errors
        DeleteSetting sRegistryAppName 'Removes the existing settings
'       If Err.Number = 5 Then Registry settings not found
    On Error GoTo 0 'Stop skipping errors
      
    lCount = 0

    vAnswer = vbNullString
    For row_RegistrySave = 1 To UBound(vContactTypeBody)
        If vContactTypeBody(row_RegistrySave, col_sStatus) = sActive Then
            lCount = lCount + 1
            vAnswer = vAnswer & vContactTypeBody(row_RegistrySave, col_sName)
            If row_RegistrySave < UBound(vContactTypeBody) Then
                vAnswer = vAnswer & "; " 'string array seprated by the semi-colon
            End If
        End If
    Next row_RegistrySave
    SaveSetting sRegistryAppName, sRegistrySection, sRegistryKey & "_Count", lCount 'Saves the number of entries to the Registry
    SaveSetting sRegistryAppName, sRegistrySection, sRegistryKey & "_Name", vAnswer 'Saves the Customer Type names to the Registry
  
    vAnswer = vbNullString
    For row_RegistrySave = 1 To UBound(vContactTypeBody)
        If vContactTypeBody(row_RegistrySave, col_sStatus) = sActive Then
            vAnswer = vAnswer & vContactTypeBody(row_RegistrySave, col_sDescription)
            If row_RegistrySave < UBound(vContactTypeBody) Then
                vAnswer = vAnswer & "; " 'string array seprated by the semi-colon
            End If
        End If
    Next row_RegistrySave
    SaveSetting sRegistryAppName, sRegistrySection, sRegistryKey & "_Description", vAnswer 'Saves the Customer Type descriptions to the Registry
  
End Sub

 

[Diane Poremsky]

I'll have to look closer at the code but I just got back from vacation and have a lot to catch up on.... but:

1. The value is not being saved once chosen? Or it may be that it is getting deleted by my code (more likely), I just am not finding the right way to keep it yet. If I select "Customer" for a contact, close the contact window and reopen that contact, it is back to blank.

I'm guessing it's being read from the registry each time you open it. Or the code is forcing a new, blank form.

If you only need to look up a contact, using Outlook code in Excel should do it. (Earlier, I thought you were using the registry to store possible names to use in a list or combobox.)