Avatar of skycity872
skycity872
 asked on

Custom Form in Outlook 2003

My question:  In Outlook is there a way to link a contact to a journal entry without having to use a loop?

Hello,

I am designing a custom form in Outlook 2003 using VBScript.  When I open a contact, I want a button that you can click which opens a new journal entry.  At the bottom of any journal entry is a text box with a "Contacts" button next to it.  I want to automatically populate the text box with the name of the contact so that the journal entry is linked to the contact.  

I am successfully doing this with the code below.  However I am currently having to loop through all the contacts to find the contact.  The user I am writing the code for has hundreds of contacts, so this loop is taking forever.  I tried to replace the loop with the code colLinks.Add(Me.FullName) but this did not work because Me.FullName is not the right type of object for the Add function.  So is there a way to link a contact to a journal entry without having to use a loop?

Thank you,

Joey



Sub CommandButton2_Click()
  Me.Save  'this saves the contact in case it is a new contact
  Const olContactItem = 2, olFolderContacts = 10
  Set objContact = Application.CreateItem(4)
  objContact.Type = "Note"

  Set colLinks = objContact.Links
  Set objNS = Application.GetNameSpace("MAPI")
  Set objFolder = objNS.GetDefaultFolder(olFolderContacts)
  Set colContacts = objFolder.Items

  'THIS LOOP IS WHAT I WANT TO CHANGE
  For Each myContact in colContacts
    If Instr(myContact.MessageClass,"IPM.Contact") Then
      If myContact.FullName = Me.FullName Then colLinks.Add(myContact)
    End If
  Next

  objContact.Display


End Sub
OutlookVB Script

Avatar of undefined
Last Comment
skycity872

8/22/2022 - Mon
Robberbaron (robr)

based upon http://msdn.microsoft.com/en-us/library/ff868983.aspx, i think you need to alter your method a bit.


if the button is on a contact form....

'Me' should be a Contact Item.

Sub Button_Click()
    AddJournal (Me)
End Sub

Sub AddJournal(thisContact)
 
    Dim myNameSpace As Outlook.NameSpace
    
    Dim myFolder As Outlook.Folder
    
    Dim myJournal As Outlook.JournalItem
    
    Dim myContact As Outlook.ContactItem
    
  
    Set myContact = thisContact
    
    Set myJournal = Application.CreateItem(olJournalItem)
    
    myJournal.Links.Add myContact
    
    myJournal.Display False
    

 
End Sub

Open in new window

skycity872

ASKER
Great, thank you!  I will test out this solution later today when I can get to my computer.  It looks like this could work well.
skycity872

ASKER
I finally was able to get to my computer after being on vacation the past few days.  I looked at your code but I think this is VBA code.  I have been using VB Script since that is what Outlook uses when designing a custom form.  The way I get to the code is Tools -> Forms -> Design a Form, then on the custom form Form -> View Code.  Is there a way to add a button that uses VBA, or is there a VBScript version of the code you submitted?  Thank you.
Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes
ASKER CERTIFIED SOLUTION
Robberbaron (robr)

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
skycity872

ASKER
That link was super helpful.  It turns out my loop can be replaced with the code of   Set oLinks = colLinks.Add(Item).  I posted the working code below.  Thanks for your help!


Sub CommandButton2_Click()
  'This button creates a note
  Me.Save  'this saves the contact in case it is a new contact
  Const olContactItem = 2, olFolderContacts = 10
  Set objContact = Application.CreateItem(4)
  objContact.Type = "Note"

  Set colLinks = objContact.Links
  Set objNS = Application.GetNameSpace("MAPI")
  Set objFolder = objNS.GetDefaultFolder(olFolderContacts)
  Set colContacts = objFolder.Items


  Set oLinks = colLinks.Add(Item)

  'Contact must be saved for links to work
  objContact.Save



  objContact.Display
 

End Sub