[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 982
  • Last Modified:

Rebuilding the NickName Cache file via VB Macro.

We all have those users who believe that when they type out a name into their little "To:" bar they are in fact adding contacts to their outlook, not realizing that this feature merely indulges their laziness and makes it hell on us I.T. folk anytime someone corrupts their ost/pst, or a system hard drive crash, or new computer is deployed.

So I've gotten used to copying the nickname cache file, and moving it from profile to profile to keep my users happy.

Until today.

A hard drive crash, on an old notebook that had never been backed up to the nearest server. Fortunately all of their mail was on the server (ost)

But a nickname cache with names in the thousands (surprised it hasn't crashed already?) was lost, and I have an angery harpy of a VP snarling down my neck about her 'contacts'. Please help.

I found a vbs macro which claims to pull the email addresses out of the sent items folder, then create a new email with all of those emails in the "To: " field as addressees. This would repopulate a new cache file, and solve my problem.

Unfortunately I am a coding idiot, well that, and the script in question doesn't appear to be functional.

Can anyone look over this and find the flaws?


Thanks

Mad Manuel.

Code Begins:

Public Sub GetSentItemsAddresses()
    Dim olApp As New Outlook.Application
    Dim myNamespace As NameSpace
    Dim oSentItems As Outlook.MAPIFolder
    Dim oEmail As Outlook.MailItem
    Dim oNewEmail As Outlook.MailItem
    Dim oToString As String
    Dim oRecipientName As Outlook.Recipient
    Dim oEmailSubject As String
 
    oEmailSubject = "Build Nickname Emails"
 
    If MsgBox("Cancel now if you are not working offline (otherwise you will send a blank email to everyone you have ever sent en email to).", vbOKCancel, "Confirm you are Offline") = vbCancel Then Exit Sub
 
    Set myNamespace = olApp.GetNamespace("MAPI")
    Set oSentItems = myNamespace.GetDefaultFolder(olFolderSentMail)
 
    For Each oEmail In oSentItems.Items
        For Each oRecipientName In oEmail.Recipients
            If InStr(1, oRecipientName.Address, "@") <> 0 And InStr(1, oToString, oRecipientName.Address) = 0 Then
                oToString = oToString + oRecipientName.Address + ";"
            End If
        Next
    Next
 
    ' send a new email (which will save the addresses in the nickname file)
    Set oNewEmail = olApp.CreateItem(olMailItem)
    oNewEmail.To = oToString
    oNewEmail.Subject = oEmailSubject
    oNewEmail.Send
 
    MsgBox "Please delete the email named " + oEmailSubject + " from the Outbox"
End Sub


0
MadManuel
Asked:
MadManuel
  • 11
  • 10
1 Solution
 
MadManuelAuthor Commented:

Public Sub GetSentItemsAddresses()
    Dim olApp As New Outlook.Application
    Dim myNamespace As NameSpace
    Dim oSentItems As Outlook.MAPIFolder
    Dim oEmail As Outlook.MailItem
    Dim oNewEmail As Outlook.MailItem
    Dim oToString As String
    Dim oRecipientName As Outlook.Recipient
    Dim oEmailSubject As String
 
    oEmailSubject = "Build Nickname Emails"
 
    If MsgBox("Cancel now if you are not working offline (otherwise you will send a blank email to everyone you have ever sent en email to).", vbOKCancel, "Confirm you are Offline") = vbCancel Then Exit Sub
 
    Set myNamespace = olApp.GetNamespace("MAPI")
    Set oSentItems = myNamespace.GetDefaultFolder(olFolderSentMail)
 
    For Each oEmail In oSentItems.Items
        For Each oRecipientName In oEmail.Recipients
            If InStr(1, oRecipientName.Address, "@") <> 0 And InStr(1, oToString, oRecipientName.Address) = 0 Then
                oToString = oToString + oRecipientName.Address + ";"
            End If
        Next
    Next
 
    ' send a new email (which will save the addresses in the nickname file)
    Set oNewEmail = olApp.CreateItem(olMailItem)
    oNewEmail.To = oToString
    oNewEmail.Subject = oEmailSubject
    oNewEmail.Send
 
    MsgBox "Please delete the email named " + oEmailSubject + " from the Outbox"
End Sub

Open in new window

0
 
MadManuelAuthor Commented:
Thought it might help someone..

I know enough to see where the rem statements are, and I think possibly there is something wrong with line 27,,, but after that i'm tapped.

Also:
Original Source for script/macro in question:

http://www.computerdoctor.com.au/FAQ/RebuildOutlookNicknameCache/nickname.asp
0
 
Chris BottomleyCommented:
The script looks ok ... you don't say what goes wrong but perhapsd there are too many email addresses?

The following adaption of your script does two things ...

1. Processes the addresses in blocks of 100
2. Automatically deletes the email

Chris
Public Sub GetSentItemsAddresses()
    Dim olApp As New Outlook.Application
    Dim myNamespace As NameSpace
    Dim oSentItems As Outlook.MAPIFolder
    Dim oEmail As Outlook.mailitem
    Dim oNewEmail As Outlook.mailitem
    Dim oToString As String
    Dim oRecipientName As Outlook.Recipient
    Dim oEmailSubject As String
    Dim filt As String
    Dim mai As mailitem
    Dim mailcount As Integer
 
    oEmailSubject = "Build Nickname Emails"
 
    If MsgBox("Cancel now if you are not working offline (otherwise you will send a blank email to everyone you have ever sent en email to).", vbOKCancel, "Confirm you are Offline") = vbCancel Then Exit Sub
 
    Set myNamespace = olApp.GetNamespace("MAPI")
    Set oSentItems = myNamespace.GetDefaultFolder(olFolderSentMail)
 
    For mailcount = 1 To oSentItems.Items.Count
        Set oEmail = oSentItems.Items(mailcount)
'    For Each oEmail In oSentItems.Items
        For Each oRecipientName In oEmail.Recipients
            If InStr(1, oRecipientName.Address, "@") <> 0 And InStr(1, oToString, oRecipientName.Address) = 0 Then
                oToString = oToString + oRecipientName.Address + ";"
            End If
        Next
        If mailcount Mod 100 = 0 Then
            Set oNewEmail = olApp.CreateItem(olMailItem)
            oNewEmail.To = oToString
            oNewEmail.subject = oEmailSubject
            oNewEmail.Send
            filt = oEmailSubject
            Set mai = olApp.Session.GetDefaultFolder(4).Items.Find("[Subject]=" & filt)
            mai.Delete
            oToString = ""
        End If
    Next
 
'    MsgBox "Please delete the email named " + oEmailSubject + " from the Outbox"
 
End Sub

Open in new window

0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
Chris BottomleyCommented:
n.b. ... you are running it from outlook aren't you?

Chris
0
 
MadManuelAuthor Commented:
Trying to.

How would you recommend running this?
0
 
Chris BottomleyCommented:
>>  How would you recommend running this?

Same way as before? , certainly via alt + F8

Chris
0
 
MadManuelAuthor Commented:
The error message I get kicked back is "outlook does not recognize one or more names"
0
 
MadManuelAuthor Commented:
Being coding idiot here:

Is there a macro command that can tell outlook to skip over the names it doesn't recognize?
0
 
Chris BottomleyCommented:
AN idiot doesn't ask!  Yes there is in principle but it's knowing what the problem is in order to bypass it.

Are you using an exchange server?

Chris
0
 
MadManuelAuthor Commented:
Also, and I realize I may have to take a course on this to understand your script, but is there a quick way to change which folder it is drawing the addresses from? From sent items to deleted items for example?

There needs to be a radial button in here where we can skip right on past the 500 points and just hit 'bottle o' talisker's' -
0
 
MadManuelAuthor Commented:
Exchange 2k3 I believe, with email stored in .ost
0
 
Chris BottomleyCommented:
I suspect then that some of the 'recipients are no longer in the server name store.  Still looking at how to exclude any such easily.

Chris
0
 
MadManuelAuthor Commented:
actually, in testing the cache file, 90% of the random sampling of email addresses have shown up in the cache file.
0
 
Chris BottomleyCommented:
Cannot be quite what I thought as the script only processes 'external' emails.  Still looking to try and get some ideas.

Chris
0
 
Chris BottomleyCommented:
I have not been able to get to an exchange pc but the following may help

Chris
Public Sub GetSentItemsAddresses()
    Dim olApp As New Outlook.Application
    Dim myNamespace As NameSpace
    Dim oSentItems As Outlook.MAPIFolder
    Dim oEmail As Outlook.mailitem
    Dim oNewEmail As Outlook.mailitem
    Dim oToString As String
    Dim oRecipientName As Outlook.Recipient
    Dim oEmailSubject As String
    Dim filt As String
    Dim mai As mailitem
    Dim mailcount As Integer
 
    oEmailSubject = "Build Nickname Emails"
 
    If MsgBox("Cancel now if you are not working offline (otherwise you will send a blank email to everyone you have ever sent en email to).", vbOKCancel, "Confirm you are Offline") = vbCancel Then Exit Sub
 
    Set myNamespace = olApp.GetNamespace("MAPI")
    Set oSentItems = myNamespace.GetDefaultFolder(olFolderSentMail)
 
    For mailcount = 1 To oSentItems.Items.Count
        Set oEmail = oSentItems.Items(mailcount)
'    For Each oEmail In oSentItems.Items
        For Each oRecipientName In oEmail.Recipients
            If InStr(1, oRecipientName.Address, "@") <> 0 And InStr(1, oToString, oRecipientName.Address) = 0 And oRecipientName.Resolve Then
                oToString = oToString + oRecipientName.Address + ";"
            End If
        Next
        If mailcount Mod 100 = 0 Then
            Set oNewEmail = olApp.CreateItem(olMailItem)
            oNewEmail.To = oToString
            oNewEmail.subject = oEmailSubject
            oNewEmail.Send
            filt = oEmailSubject
            Set mai = olApp.Session.GetDefaultFolder(4).Items.Find("[Subject]=" & filt)
            mai.Delete
            oToString = ""
        End If
    Next 
End Sub

Open in new window

0
 
MadManuelAuthor Commented:
So I think despite generating the error message, it still populated and then deleted the email with valid addresses.

How would I change the source folder in the script to switch the source locations for the emails?
From sent to deleted, or sent to "inbox" ?

is it just changing the "oSentItems" element to 'oInbox' or 'oDeletedItems' ?
0
 
Chris BottomleyCommented:
Yes, the range of possible valueds for the constants are:

olFolderDeletedItems, (3) - The Deleted Items folder.
olFolderOutbox, (4) - The Outbox folder.
olFolderSentMail, (5) - The Sent Mail folder.
olFolderInbox, (6) - The Inbox folder.
olFolderCalendar, (9) - The Calendar folder.
olFolderContacts, (10) - The Contacts folder.
olFolderJournal, (11) - The Journal folder.
olFolderNotes, (12) - The Notes folder.
olFolderTasks, (13) - The Tasks folder.
olFolderDrafts, (16) - The Drafts folder.
olPublicFoldersAllPublicFolders, (18) - The All Public Folders folder in the Exchange Public Folders store.
olFolderConflicts, (19) - The Conflicts folder (subfolder of Sync Issues folder). Only available for an Exchange account.
olFolderSyncIssues, (20) - The Sync Issues folder. Only available for an Exchange account.
olFolderLocalFailures, (21) - The Local Failures folder (subfolder of Sync Issues folder). Only available for an Exchange account.
olFolderServerFailures, (22) - The Server Failures folder (subfolder of Sync Issues folder). Only available for an Exchange account.
olFolderJunk, (23) - The Junk E-Mail folder.
olFolderRssFeeds, (25) - The RSS Feeds folder.
olFolderToDo, (28) - The To Do folder.
olFolderManagedEmail, (29) - The top-level folder in the Managed Folders group, Only available for an Exchange account.  

Chris
0
 
Chris BottomleyCommented:
The issue with inbox is the script will not work since you will need to process the senderemailaddress and some of the deleted items will be inbound and have the same problem.

Chris
0
 
MadManuelAuthor Commented:
The man is a god.
0
 
Chris BottomleyCommented:
Here was I expecting some guidance on adapting to work with inbox items!  If you do then I think a new question will be appropriate as then you will get maximum input from experts.

Thank's for the comment, but i'm used to people saying oh God! whenever I say something :o)

Chris
0
 
MadManuelAuthor Commented:
Actually, I didn't realize that accepting your stuff as the solution would close the conversation. Seems kind of silly actually, kind of shuts down the proverbial train of thought.
0

Featured Post

Get quick recovery of individual SharePoint items

Free tool – Veeam Explorer for Microsoft SharePoint, enables fast, easy restores of SharePoint sites, documents, libraries and lists — all with no agents to manage and no additional licenses to buy.

  • 11
  • 10
Tackle projects and never again get stuck behind a technical roadblock.
Join Now