vb2003 outlook addin hangs on exit 
Author Message
 vb2003 outlook addin hangs on exit

I'm trying to write an addin for Outlook 2000 to allow users to be notified
when a new item is posted to a public folder. Everything is seemingly
working, however outlook 2000 hangs on exit, 'Please wait while Outlook
Exits' and needs to be killed with Task Manager.

I have done a fair bit of web searching, and commenting out bits of code,
and it seems that it only occurs when a connection is made to a public
folder. The registry reading stuff is fine, as is opening a connection to
the namespace. The code to display the form is also (probably) fine as with
that removed the problem still happens.

Here is a copy of my connect.vb, any help would be appreciated.

Regards,
Stuart Gardner

Imports Microsoft.Office.Core
imports Extensibility
imports System.Runtime.InteropServices

<GuidAttribute("29F7C099-F409-48C1-9F72-992BD45615B8"),
ProgIdAttribute("FaxMonitor.Connect")> _
Public Class Connect

    Implements Extensibility.IDTExtensibility2

    Public golApp As New Outlook.Application
    Public gnspNameSpace As Outlook.NameSpace

    Dim WithEvents F5491254 As Outlook.Items
    Dim WithEvents FAccounts As Outlook.Items
    Dim WithEvents FAdmin As Outlook.Items
    Dim WithEvents FOperationsSupport As Outlook.Items
    Dim WithEvents FProjectsAndContracts As Outlook.Items
    Dim WithEvents FSales As Outlook.Items
    Dim WithEvents FStores As Outlook.Items
    Dim WithEvents FWorkshop As Outlook.Items
    Dim WithEvents CorusOrders As Outlook.Items
    Dim WithEvents WebEnquiries As Outlook.Items

    Public Sub OnBeginShutdown(ByRef custom As System.Array) Implements
Extensibility.IDTExtensibility2.OnBeginShutdown

        F5491254 = Nothing
        FAccounts = Nothing
        FAdmin = Nothing
        FOperationsSupport = Nothing
        FProjectsAndContracts = Nothing
        FSales = Nothing
        FStores = Nothing
        FWorkshop = Nothing
        CorusOrders = Nothing
        WebEnquiries = Nothing

        gnspNameSpace = Nothing
        golApp = Nothing

    End Sub

    Public Sub OnAddInsUpdate(ByRef custom As System.Array) Implements
Extensibility.IDTExtensibility2.OnAddInsUpdate
    End Sub

    Public Sub OnStartupComplete(ByRef custom As System.Array) Implements
Extensibility.IDTExtensibility2.OnStartupComplete
        Dim reg As Microsoft.Win32.Registry
        Dim key As Microsoft.Win32.RegistryKey

        gnspNameSpace = golApp.GetNamespace("MAPI")
        key = reg.CurrentUser.OpenSubKey("Software\\Stuart Gardner\\Fax
Monitor")
        Try
            If key.GetValue("F5491254", 1) = 1 Then
                F5491254 = GetFolder("Public Folders\All Public
Folders\Received Faxes\549 1254")
            End If
            If key.GetValue("FAccounts", 1) = 1 Then
                FAccounts = GetFolder("Public Folders\All Public
Folders\Received Faxes\Accounts")
            End If
            If key.GetValue("FAdmin", 1) = 1 Then
                FAdmin = GetFolder("Public Folders\All Public
Folders\Received Faxes\Admin")
            End If
            If key.GetValue("FOperationsSupport", 1) = 1 Then
                FOperationsSupport = GetFolder("Public Folders\All Public
Folders\Received Faxes\Operations Support")
            End If
            If key.GetValue("FProjectsAndContracts", 1) = 1 Then
                FProjectsAndContracts = GetFolder("Public Folders\All Public
Folders\Received Faxes\Projects & Contracts")
            End If
            If key.GetValue("FSales", 1) = 1 Then
                FSales = GetFolder("Public Folders\All Public
Folders\Received Faxes\Sales")
            End If
            If key.GetValue("FStores", 1) = 1 Then
                FStores = GetFolder("Public Folders\All Public
Folders\Received Faxes\Stores")
            End If
            If key.GetValue("FWorkshop", 1) = 1 Then
                FWorkshop = GetFolder("Public Folders\All Public
Folders\Received Faxes\Workshop")
            End If
            If key.GetValue("CorusOrders", 1) = 1 Then
                CorusOrders = GetFolder("Public Folders\All Public
Folders\Corus Orders")
            End If
            If key.GetValue("WebEnquiries", 1) = 1 Then
                WebEnquiries = GetFolder("Public Folders\All Public
Folders\Web Enquiries")
            End If
        Catch
        End Try
        key.Close()
        reg = Nothing
        MsgBox("Started v10")

    End Sub

    Public Sub OnDisconnection(ByVal RemoveMode As
Extensibility.ext_DisconnectMode, ByRef custom As System.Array) Implements
Extensibility.IDTExtensibility2.OnDisconnection
    End Sub

    Public Sub OnConnection(ByVal application As Object, ByVal connectMode
As Extensibility.ext_ConnectMode, ByVal addInInst As Object, ByRef custom As
System.Array) Implements Extensibility.IDTExtensibility2.OnConnection
    End Sub

    Private Sub DisplayNotification(ByVal Item As Object, ByVal Folder As
String, Optional ByVal Kind As String = "fax", Optional ByVal From As String
= "for")
        ' Displays a new-mail style notification. The optional parameters
are used to correct
        ' grammar. Item is as passed by the ItemAdd event and is required to
display the message

        Dim Notify As New FaxMonitor.Form1

        Notify.Item = Item
        Notify.Kind = Kind
        Notify.Label1.Text = "New " + Kind + " has arrived " + From + " " +
Folder + ". Would you like to view it now"
        Notify.Show()

    End Sub

    Private Sub F5491254_ItemAdd(ByVal Item As Object) Handles
F5491254.ItemAdd
        DisplayNotification(Item:=Item, Folder:="549 1254", From:="on")
    End Sub

    Private Sub FAccounts_ItemAdd(ByVal Item As Object) Handles
FAccounts.ItemAdd
        DisplayNotification(Item:=Item, Folder:="Accounts")
    End Sub

    Private Sub FAdmin_ItemAdd(ByVal Item As Object) Handles FAdmin.ItemAdd
        DisplayNotification(Item:=Item, Folder:="Admin")
    End Sub

    Private Sub FOperationsSupport_ItemAdd(ByVal Item As Object) Handles
FOperationsSupport.ItemAdd
        DisplayNotification(Item:=Item, Folder:="Operations Support")
    End Sub

    Private Sub FProjectsAndContracts_ItemAdd(ByVal Item As Object) Handles
FProjectsAndContracts.ItemAdd
        DisplayNotification(Item:=Item, Folder:="Projects && Contracts")
    End Sub

    Private Sub FSales_ItemAdd(ByVal Item As Object) Handles FSales.ItemAdd
        DisplayNotification(Item:=Item, Folder:="Sales")
    End Sub

    Private Sub FStores_ItemAdd(ByVal Item As Object) Handles
FStores.ItemAdd
        DisplayNotification(Item:=Item, Folder:="Stores")
    End Sub

    Private Sub FWorkshop_ItemAdd(ByVal Item As Object) Handles
FWorkshop.ItemAdd
        DisplayNotification(Item:=Item, Folder:="Workshop")
    End Sub

    Private Sub CorusOrders_ItemAdd(ByVal Item As Object) Handles
CorusOrders.ItemAdd
        DisplayNotification(Item:=Item, Folder:="Corus", Kind:="order",
From:="from")
    End Sub

    Private Sub WebEnquiries_ItemAdd(ByVal Item As Object) Handles
WebEnquiries.ItemAdd
        DisplayNotification(Item:=Item, Folder:="Web Enquiries",
Kind:="message", From:="in")
    End Sub

    Public Function GetFolder(ByVal strFolderPath As String) As
Outlook.Items
        ' Retrieves a handle to a public folder. Pinched from a website but
I forget which one sorry.
        ' Folder path needs to be something like
        '   "Public Folders\All Public Folders\Company\Sales"

        Dim colFolders As Outlook.Folders
        Dim objFolder As Outlook.MAPIFolder
        Dim arrFolders() As String

        Dim I As Long
        On Error Resume Next

        'strFolderPath = Replace(strFolderPath, "/", "\")
        arrFolders = Split(strFolderPath, "\")
        MsgBox(Split(strFolderPath, "\"))
        objFolder = gnspNameSpace.Folders.Item(arrFolders(0))
        If Not objFolder Is Nothing Then
            For I = 1 To UBound(arrFolders)
                colFolders = objFolder.Folders
                objFolder = Nothing
                objFolder = colFolders.Item(arrFolders(I))
                If objFolder Is Nothing Then
                    Exit For
                End If
            Next
        End If

        GetFolder = objFolder.Items
        colFolders = Nothing
        objFolder = Nothing

    End Function

End Class



Sun, 27 Nov 2005 18:52:45 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. Outlook Addin won't allow Outlook to Exit properly

2. After Running Macro, Outlook hangs on exit.

3. Outlook COM Add In problem: Outlook wouldn't exit from Process in Task Manager

4. Word 2000 with template attached hangs on exit

5. Word hangs on exit

6. Word hangs on exit...

7. Application hangs on exit (VB6)

8. computer hangs when exiting

9. Hang when App exits

10. Application hangs on exit under Win2K

11. OCX causes VB6 to hang on exit

12. Hang on application exit after using INET

 

 
Powered by phpBB® Forum Software