- Subject: Adding Shortcut, Receive: Run-time error '-2147467259 (80004005)'
- Author: bryan.powell2@gmail.com
- Date: 02 May 2008
- References:
Hello!
I wrote a script that uses the NewMail event to check if the sender of
the new message is in a distro list in the GAL, and create a folder in
a PST file, and add a shortcut to my shortcut pane if there is not
already one.
Everything works, but if it's a sender that does not already have a
folder/shortcut it gives me an error when adding the shortcut. If I
go into Debug and, without making any changes to the code, tell it try
again, everything works fine.
My only thought is that it takes a second to create the folder in the
PST file, and I'm adding the shortcut before that operation can
complete. If that's the case, is there a way around it? If it's
something else, what is it?
Any help is appreciated.
Here's my code:
Private Sub Application_NewMail()
Dim objMail As Variant
Dim InboxItems As Outlook.Items
Dim DestFolder As Outlook.MAPIFolder
Dim objShortcuts As OutlookBarShortcuts
Dim objShortcut As OutlookBarShortcut
Dim objGroup As OutlookBarGroup
Dim objGroups As OutlookBarGroups
Dim objListing As AddressEntry
Dim SanName As String
Set ns = GetNamespace("MAPI")
Set objListing = ns.AddressLists("Global Address
List").AddressEntries("Dist_List")
Set InboxItems = ns.GetDefaultFolder(olFolderInbox).Items
Set DestFolder = GetFolder("Personal Folders\People")
Set objMail = InboxItems.GetFirst
If InList(objMail.SenderName, objListing) Then
SanName = objMail.SenderName
For Count = 1 To DestFolder.Folders.Count
If DestFolder.Folders(Count).Name = SanName Then
objMail.Move DestFolder.Folders(Count)
Exit Sub
End If
Next Count
DestFolder.Folders.Add SanName
objMail.Move GetFolder("Personal Folders\People\" & SanName)
Set objGroups = ActiveExplorer.Panes(1).Contents.Groups
For i = 1 To objGroups.Count
If objGroups(i).Name = "Contacts" Then
Set objShortcuts = objGroups(i).Shortcuts
'ERROR on ADD operation
objGroups(i).Shortcuts.Add GetFolder("Personal Folders
\People\" & _
SanName), SanName
End If
Next i
End If
End Sub
Function InList(Name As String, MainList As AddressEntry) As Boolean
If MainList.DisplayType = olDistList Then
For i = 1 To MainList.Members.Count
If InList(Name, MainList.Members(i)) Then
InList = True
Exit Function
End If
Next i
Else
If MainList.Name = Name Then
InList = True
Else
InList = False
End If
End If
End Function
Function Sanitize(str) As String
str =
Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(str,
"?", ""), "/", ""), "*", ""), "\", ""), ":", ""), Chr(34), ""), "<",
""), ">", ""), "|", "")
Sanitize = str
End Function