Contact Page 2 Combobox via Registry

Status
Not open for further replies.

bnj1776

New Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
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
 
Registry Values (array via comma separated values) :
Code:
ContactTypeCount
REG_SZ
3

ContactTypeName
REG_SZ
Vendor, Contractor, Customer

ContactTypeDescription
REG_SZ
Vendor/Supplier, Contractor, Owner


VBScript in the Contact form:
Code:
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
Code:
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
Code:
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
 
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.
 
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.

Code:
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?
 
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.
 
Thank you Diane.
This part of the project is done.
Here is a copy of the Registry save code I'm using in Execl ...


Code:
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
 
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.)
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
J Contact page too large for screen. Can't see categories, etc. Using Outlook 1
U can you add a new field to outlooks contact page Outlook VBA and Custom Forms 1
G Outlook 2021 Add Picture to Custom Contact Form Outlook VBA and Custom Forms 2
AndyZ Contact Custom Form Tiny Text Outlook VBA and Custom Forms 3
A How to reduce size of custom contact form? Outlook VBA and Custom Forms 3
S Custom Contact card - need help creating one Outlook VBA and Custom Forms 1
U Outlook 2021 not showing contact cards in Searches Using Outlook 1
Witzker Outlook 2019 Macro to seach in all contact Folders for marked Email Adress Outlook VBA and Custom Forms 1
Witzker How to get the button Karte ( map) in custom contact form Outlook VBA and Custom Forms 2
G Adding a contact to a specific folder Using Outlook 0
B Linking contact to an Appointment Using Outlook 1
Witzker Outlook 2019 How to get a Photo in a User Defined Contact form Outlook VBA and Custom Forms 2
Witzker Outlook 2019 Macro to send an Email Template from User Defined Contact Form Outlook VBA and Custom Forms 0
jehan2256 "History" button in Business Contact Manager Using Outlook 1
Witzker Outlook 2019 Edit contact from email does not open the user defined contactform Using Outlook 3
Horsepower Contact phone numbers randomly change Using Outlook 0
Witzker Set Cursor & Focus from any field to the body of a user Contact form in OL 2019 Outlook VBA and Custom Forms 1
Witzker Place cursor at opening, a user defined OL contact form Outlook VBA and Custom Forms 3
M Contact deletion Using Outlook 2
R Roadrunner Email Settings | Contact Roadrunner Customer Support Outlook VBA and Custom Forms 0
M Accessing ALL Outlook contact fields Outlook VBA and Custom Forms 3
S Outlook 365 Shared mailbox contact group member numbers not matching Using Outlook 0
D Contact Group - Adding Bulk Addresses Using Outlook 2
F Outlook 365 No scroll bars in Contact Using Outlook 2
N Contact Form Notes Field Touch vs Mouse Using Outlook 0
J "Contact" button in Journal entry Using Outlook 1
Witzker How to find all emails from and to a contact in OL 2019 Using Outlook 6
D Advanced e-Mail search on from/to contact group only searches for first 20 contacts in group Using Outlook 0
G Send a greeting message to a contact on birthday Outlook VBA and Custom Forms 5
S CONTACT FIELD PRINT ORDER Outlook VBA and Custom Forms 1
I Button PDF in Outlook Contact custom form Outlook VBA and Custom Forms 1
O Outlook 365 - How to create / copy a new contact from an existing one? Using Outlook 5
N contact list seen in Contact folder but knot in Address book or when 'TO' button is clicked in new email Using Outlook 0
M Disable Contact Card Results when using "Search People" in Outlook Ribbon Using Outlook 7
M Contact suggestion Using Outlook 2
H Custom Outlook Contact Form VBA Outlook VBA and Custom Forms 1
Witzker HowTo Change message Class of contact form Outlook VBA and Custom Forms 0
Witzker Open Contact missing in Outlook 2019 Using Outlook 2
Witzker HowTo start a macro with an Button in OL contact form Outlook VBA and Custom Forms 12
Witzker Pls help to change the code for inserting date in Ol contact body Outlook VBA and Custom Forms 5
R Time for another article on contact cards? Using Outlook 0
O Create a custom contact form - questions before messing things up... Outlook VBA and Custom Forms 4
M vCard does not have user-defined fields from my custom contact form (365) Using Outlook 1
C Copy Outlook contact field value to another field Outlook VBA and Custom Forms 1
W Remove specific contacts from contact list Outlook VBA and Custom Forms 3
GregS 2016 Contact List being managed by Outlook.com? Using Outlook 1
F Copy and replace not update contact in another pst Using Outlook 0
A Sending contact vcards sends older version instead of updated version Using Outlook 4
T Outlook 2010 Correct way to map multiple contact fields Using Outlook 4
Victor_50 Outlook 2013 Custom Contact Form starts with "E-mail 2" Outlook VBA and Custom Forms 2

Similar threads

Back
Top