• Subject: Adding Shortcut, Receive: Run-time error '-2147467259 (80004005)'
  • Author: bryan.powell2@gmail.com
  • Date: 02 May
  • 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
02 MayAdding Shortcut, Receive: Run-time error '-2147467259 (80004005)'.bryan.powell2@gmail.com
05 May\ Re: Adding Shortcut, Receive: Run-time error '-2147467259 (80004005)'.Ken Slovak - [MVP - O...
06 May   \ Re: Adding Shortcut, Receive: Run-time error '-2147467259 (80004005)'.bryan.powell2@gmail.com
All times are in (US) Eastern Daylight Time (GMT -4:00)