C
Christoph
Hello,
I wrote an Outlook Add-In for Ol9 and it normally works fine with
Outlook2000/XP/2003.
I use Redemption and AddInMon. Therefore I'm not using
IDTExtensibility2.
I'm trapping Explorer_Close Event and On_disconnection for releasing
objects (and I really release all objects). I do not use CreateObject
because of problems with script stoppers.
But in some cases the add-in causes troubles. Some people using the
add-in have the Resiliency problem with the well-known error message by
disabling the add-in. Some people are getting the "Microsoft Outlook
encountered a problem and..." message after closing Outlook. Although
error messages the functionality of the add-in always works fine.
I commented out error handling and in most cases nothing changed. No
error message or crash during Outlook sessions. In some cases the
problems were saved (and that's really strange).
I tested a lot, but I didn't get these errors. And I was testing many
Outlook versions with different operating systems and virus scanners.
I know the ItemsCB example. But because of using AddInMon the code is
different. And I'm not using classes like it's in ItemsCB. But I
don't think that can cause the problems.
Now I'm desperate, because the add-in is working fine in some cases
and it's causing these errors in other cases.
Here is a part of my code: (I hope it's not too much!)
Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As
Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
'Outlook Variablen
Private WithEvents moApplication As Outlook.Application
Private WithEvents moNameSpace As Outlook.NameSpace
Private WithEvents moActiveExplorer As Outlook.Explorer
Private msProgID As String
Private moContactsFolder As Outlook.MAPIFolder
Private WithEvents moContactItems As Outlook.Items
Private moCalendarFolder As Outlook.MAPIFolder
Private WithEvents moCalendarItems As Outlook.Items
Private moTaskFolder As Outlook.MAPIFolder
Private WithEvents moTaskItems As Outlook.Items
Private moDeleteFolder As Outlook.MAPIFolder
Private WithEvents moDeleteItems As Outlook.Items
Private obContactItem As Object
Private moContactItem As Object
Private obDistListItem As Object
Private moDistListItem As Object
Private obCalendarItem As Object
Private moCalendarItem As Object
Private obTasksItem As Object
Private moTasksItem As Object
'Office Variablen
Dim WithEvents objPropertiesButton As Office.CommandBarButton
Dim WithEvents objUserAdminButton As Office.CommandBarButton
Dim WithEvents objSynchButton As Office.CommandBarButton
Dim WithEvents objAktualButton As Office.CommandBarButton
Dim WithEvents objImportButton As Office.CommandBarButton
Dim WithEvents objExportButton As Office.CommandBarButton
Dim WithEvents objRegButton As Office.CommandBarButton
Dim WithEvents objHelpButton As Office.CommandBarButton
Private Sub AddinInstance_OnAddInsUpdate(custom() As Variant)
'On Error Resume Next
'DebugWrite "AddinInstance_OnAddInsUpdate"
Call Registry.DeleteDisable
End Sub
Private Sub AddinInstance_OnBeginShutdown(custom() As Variant)
'On Error Resume Next
'DebugWrite "AddinInstance_OnBeginShutdown"
Call Registry.DeleteDisable
End Sub
Private Sub AddinInstance_OnConnection(ByVal Application As Object, _
ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, _
ByVal AddInInst As Object, custom() As Variant)
Dim lngPID As Long
Dim lngThreadID As Long
Dim iDeleteAnswer As Integer
On Error Resume Next
Call Registry.DeleteDisable
If Application.Explorers.Count > 0 Then 'Outlook launched with UI
If Not TypeName(Application.ActiveExplorer) = "Nothing" Then
'Initialisieren
Set moApplication = Application
Set DB.OlApp = Application
Set moNameSpace = moApplication.GetNamespace("MAPI")
Set moActiveExplorer = Application.ActiveExplorer
msProgID = AddInInst.ProgId
'Folder für gelöschte Objekte
Set moDeleteFolder =
moNameSpace.GetDefaultFolder(olFolderDeletedItems)
Set moDeleteItems = moDeleteFolder.Items
'Licence.gbRegVersuch = False
Licence.gfalscherLizenzCode = False
Licence.gbLizenzAbgelaufen = False
Licence.gbZuVielUser = False
DB.gImport = False
DB.gExport = False
DB.gItemAdd = False
DB.gSynch = False
DB.gTransaktionsUeberpruefung = False
DB.gVerbindungFehler = False
DB.gbAddUser = False
DB.gbErsterUser = False
'Sprache festlegen
If
moApplication.Application.LanguageSettings.LanguageID(msoLanguageIDUI)
= 1031 Then
Sprachen.gsSprache = "deutsch"
ElseIf
moApplication.Application.LanguageSettings.LanguageID(msoLanguageIDUI)
= 1040 Then
Sprachen.gsSprache = "ital"
End If
Call Sprachen.InitMsgBox
'Version auslesen
If Left(moApplication.Version, 1) = "9" Then
DB.gOutlookVersion = 9
ElseIf Left(moApplication.Version, 2) = "10" Then
DB.gOutlookVersion = 10
ElseIf Left(moApplication.Version, 2) = "11" Then
DB.gOutlookVersion = 11
End If
'-------------------------------------------------------------------
'1.) Ist GAW aktiviert?
Call Registry.RegistryAktivAuslesen
If Registry.gsAktivString = "Nein" Then
DB.giDBProgrammAktiv = 0
DB.giAutoSynch = 0
'Kontakte
Call Registry.RegistryContactFolderIDAuslesen
If DB.gstrDBContactsFolderEntryID <> "" Then
Set moContactsFolder =
moNameSpace.GetFolderFromID(DB.gstrDBContactsFolderEntryID)
Set moContactItems = moContactsFolder.Items
End If
'Kalender
Call Registry.RegistryCalendarFolderIDAuslesen
If DB.gstrDBCalendarFolderEntryID <> "" Then
Set moCalendarFolder =
moNameSpace.GetFolderFromID(DB.gstrDBCalendarFolderEntryID)
Set moCalendarItems = moCalendarFolder.Items
End If
'Aufgaben
Call Registry.RegistryTaskFolderIDAuslesen
If DB.gstrDBTasksFolderEntryID <> "" Then
Set moTaskFolder =
moNameSpace.GetFolderFromID(DB.gstrDBTasksFolderEntryID)
Set moTaskItems = moTaskFolder.Items
End If
Call MenuBar
Exit Sub
Else
DB.giDBProgrammAktiv = 1
End If
'2.) DB Verbindung testen
If DBVerbindungstest(False) = False Then
'Keine Verbindung!!!!!
iDeleteAnswer = MsgBox(gsMsgBox(33), vbYesNo)
If iDeleteAnswer = vbYes Then
Call Registry.RegistryAktivSchreiben("Nein")
'Kontakte
Call Registry.RegistryContactFolderIDAuslesen
If DB.gstrDBContactsFolderEntryID <> "" Then
Set moContactsFolder =
moNameSpace.GetFolderFromID(DB.gstrDBContactsFolderEntryID)
Set moContactItems = moContactsFolder.Items
End If
'Kalender
Call Registry.RegistryCalendarFolderIDAuslesen
If DB.gstrDBCalendarFolderEntryID <> "" Then
Set moCalendarFolder =
moNameSpace.GetFolderFromID(DB.gstrDBCalendarFolderEntryID)
Set moCalendarItems = moCalendarFolder.Items
End If
'Aufgaben
Call Registry.RegistryTaskFolderIDAuslesen
If DB.gstrDBTasksFolderEntryID <> "" Then
Set moTaskFolder =
moNameSpace.GetFolderFromID(DB.gstrDBTasksFolderEntryID)
Set moTaskItems = moTaskFolder.Items
End If
DB.giDBProgrammAktiv = 0
DB.giAutoSynch = 0
MsgBox gsMsgBox(34)
Call MenuBar
Exit Sub
Else
'ODBC Einstellungen öffnen
Dim RetVal As Long
Dim SysDir As String
SysDir = Space$(256)
RetVal = modUserID.GetSystemDirectory(SysDir,
Len(SysDir))
If RetVal <> 0 Then
WebLink.ShellExec Left$(SysDir, RetVal) &
"\odbcad32.exe", vbNormalFocus
End If
DB.giDBProgrammAktiv = 0
DB.giAutoSynch = 0
'Kontakte
Call Registry.RegistryContactFolderIDAuslesen
If DB.gstrDBContactsFolderEntryID <> "" Then
Set moContactsFolder =
moNameSpace.GetFolderFromID(DB.gstrDBContactsFolderEntryID)
Set moContactItems = moContactsFolder.Items
End If
'Kalender
Call Registry.RegistryCalendarFolderIDAuslesen
If DB.gstrDBCalendarFolderEntryID <> "" Then
Set moCalendarFolder =
moNameSpace.GetFolderFromID(DB.gstrDBCalendarFolderEntryID)
Set moCalendarItems = moCalendarFolder.Items
End If
'Aufgaben
Call Registry.RegistryTaskFolderIDAuslesen
If DB.gstrDBTasksFolderEntryID <> "" Then
Set moTaskFolder =
moNameSpace.GetFolderFromID(DB.gstrDBTasksFolderEntryID)
Set moTaskItems = moTaskFolder.Items
End If
Call MenuBar
Exit Sub
End If
End If
'3.) Lizensierung
Call CheckLizenz
'4.) Menü
Call MenuBar
'5.) User Properties
If HoleUserProperties = False Then
If Licence.gfalscherLizenzCode = False And
Licence.gbZuVielUser = False And Licence.gbLizenzAbgelaufen = False
Then
Call frmAddUser.Show(vbModal)
End If
End If
DoEvents
'Kontakte
Call Registry.RegistryContactFolderIDAuslesen
If DB.gstrDBContactsFolderEntryID <> "" Then
Set moContactsFolder =
moNameSpace.GetFolderFromID(DB.gstrDBContactsFolderEntryID)
Set moContactItems = moContactsFolder.Items
End If
'Kalender
Call Registry.RegistryCalendarFolderIDAuslesen
If DB.gstrDBCalendarFolderEntryID <> "" Then
Set moCalendarFolder =
moNameSpace.GetFolderFromID(DB.gstrDBCalendarFolderEntryID)
Set moCalendarItems = moCalendarFolder.Items
End If
'Aufgaben
Call Registry.RegistryTaskFolderIDAuslesen
If DB.gstrDBTasksFolderEntryID <> "" Then
Set moTaskFolder =
moNameSpace.GetFolderFromID(DB.gstrDBTasksFolderEntryID)
Set moTaskItems = moTaskFolder.Items
End If
'Lizenz
If Licence.gfalscherLizenzCode = False And
Licence.gbZuVielUser = False And Licence.gbLizenzAbgelaufen = False
Then
DB.giDBProgrammAktiv = 1
Call frmSynch.Synchronisieren
Else
DB.giDBProgrammAktiv = 0
DB.giAutoSynch = 0
End If
'Benutzerrechte
If DB.gbErsterUser = True Then
DB.giAdmin = 1
End If
If DB.giAdmin = 0 Then
objUserAdminButton.Enabled = False
Else
objUserAdminButton.Enabled = True
End If
'Routinen für
Ersteinstiege--------------------------------------
If DB.gbAddUser = True Then
If DB.gbErsterUser = True Then
iDeleteAnswer = MsgBox(gsMsgBox(39), vbYesNo)
If iDeleteAnswer = vbYes Then
Call ExportSteuern
End If
DB.gbErsterUser = False
Else
iDeleteAnswer = MsgBox(gsMsgBox(40), vbYesNo)
If iDeleteAnswer = vbYes Then
Call SynchSteuern
End If
End If
DB.gbAddUser = False
End If
'----------------------------------------------------------------
End If
Else 'Outlook launched without UI
'Get Outlook ProcessID (same as current process ID since Add-In
runs in-process
lngPID = GetCurrentProcessId
lngThreadID = GetCurrentThreadId
If IsAddInMonProcess = False Then
'Launch AddInMonitor, supplying Add-In ProgID, Outlook PID,
ThreadID
Call Registry.RegistryAppPathAuslesen
Shell Registry.gApplicationPath & "\AddInMon.exe /n " &
AddInInst.ProgId _
& " /p " & lngPID & " /t " & lngThreadID
End If
End If
End Sub
Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode _
As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
'On Error Resume Next
If RemoveMode = ext_dm_UserClosed Then
'User shutdown removed COM Add-in
'Cleanup custom toolbars by deleting them
'Office
If Not objPropertiesButton Is Nothing Then
Set objPropertiesButton = Nothing
End If
If Not objUserAdminButton Is Nothing Then
Set objUserAdminButton = Nothing
End If
If Not objSynchButton Is Nothing Then
Set objSynchButton = Nothing
End If
If Not objAktualButton Is Nothing Then
Set objAktualButton = Nothing
End If
If Not objImportButton Is Nothing Then
Set objImportButton = Nothing
End If
If Not objExportButton Is Nothing Then
Set objExportButton = Nothing
End If
If Not objRegButton Is Nothing Then
Set objRegButton = Nothing
End If
If Not objHelpButton Is Nothing Then
Set objHelpButton = Nothing
End If
Else
'Host shutdown
End If
Call UnInitHandler
End Sub
Private Sub AddinInstance_OnStartupComplete(custom() As Variant)
'On Error Resume Next
'DebugWrite "AddinInstance OnStartupComplete"
End Sub
Private Sub moActiveExplorer_Close()
'On Error Resume Next
'Explorer Object
If Not moActiveExplorer Is Nothing Then
Set moActiveExplorer = Nothing
End If
If moApplication.Explorers.Count <= 1 Then
'Fenster
If Not frmAddUser Is Nothing Then
Unload frmAddUser
Set frmAddUser = Nothing
End If
If Not frmAddFolder Is Nothing Then
Unload frmAddFolder
Set frmAddFolder = Nothing
End If
If Not frmBenutzerverwaltung Is Nothing Then
Unload frmBenutzerverwaltung
Set frmBenutzerverwaltung = Nothing
End If
If Not frmExport Is Nothing Then
Unload frmExport
Set frmExport = Nothing
End If
If Not frmVorExport Is Nothing Then
Unload frmVorExport
Set frmVorExport = Nothing
End If
If Not frmImport Is Nothing Then
Unload frmImport
Set frmImport = Nothing
End If
If Not frmManSynch Is Nothing Then
Unload frmManSynch
Set frmManSynch = Nothing
End If
If Not frmManSynchTable Is Nothing Then
Unload frmManSynchTable
Set frmManSynchTable = Nothing
End If
If Not frmProperties Is Nothing Then
Unload frmProperties
Set frmProperties = Nothing
End If
If Not frmReaktivierung Is Nothing Then
Unload frmReaktivierung
Set frmReaktivierung = Nothing
End If
If Not frmReAktivUpdate Is Nothing Then
Unload frmReAktivUpdate
Set frmReAktivUpdate = Nothing
End If
If Not frmRegister Is Nothing Then
Unload frmRegister
Set frmRegister = Nothing
End If
If Not frmSynch Is Nothing Then
Unload frmSynch
Set frmSynch = Nothing
End If
Call UnInitHandler
End If
End Sub
Sub UnInitHandler()
On Error Resume Next
'Outlook
If Not obContactItem Is Nothing Then
Set obContactItem = Nothing
End If
If Not moContactItem Is Nothing Then
Set moContactItem = Nothing
End If
If Not obDistListItem Is Nothing Then
Set obDistListItem = Nothing
End If
If Not moDistListItem Is Nothing Then
Set moDistListItem = Nothing
End If
If Not obCalendarItem Is Nothing Then
Set obCalendarItem = Nothing
End If
If Not moCalendarItem Is Nothing Then
Set moCalendarItem = Nothing
End If
If Not obTasksItem Is Nothing Then
Set obTasksItem = Nothing
End If
If Not moTasksItem Is Nothing Then
Set moTasksItem = Nothing
End If
If Not moContactItems Is Nothing Then
Set moContactItems = Nothing
End If
If Not moDeleteItems Is Nothing Then
Set moDeleteItems = Nothing
End If
If Not moContactsFolder Is Nothing Then
Set moContactsFolder = Nothing
End If
If Not moDeleteFolder Is Nothing Then
Set moDeleteFolder = Nothing
End If
If Not moNameSpace Is Nothing Then
Set moNameSpace = Nothing
End If
If Not DB.OlApp Is Nothing Then
Set DB.OlApp = Nothing
End If
If Not moApplication Is Nothing Then
Set moApplication = Nothing
End If
End Sub
Maybe someone can help me?
I wrote an Outlook Add-In for Ol9 and it normally works fine with
Outlook2000/XP/2003.
I use Redemption and AddInMon. Therefore I'm not using
IDTExtensibility2.
I'm trapping Explorer_Close Event and On_disconnection for releasing
objects (and I really release all objects). I do not use CreateObject
because of problems with script stoppers.
But in some cases the add-in causes troubles. Some people using the
add-in have the Resiliency problem with the well-known error message by
disabling the add-in. Some people are getting the "Microsoft Outlook
encountered a problem and..." message after closing Outlook. Although
error messages the functionality of the add-in always works fine.
I commented out error handling and in most cases nothing changed. No
error message or crash during Outlook sessions. In some cases the
problems were saved (and that's really strange).
I tested a lot, but I didn't get these errors. And I was testing many
Outlook versions with different operating systems and virus scanners.
I know the ItemsCB example. But because of using AddInMon the code is
different. And I'm not using classes like it's in ItemsCB. But I
don't think that can cause the problems.
Now I'm desperate, because the add-in is working fine in some cases
and it's causing these errors in other cases.
Here is a part of my code: (I hope it's not too much!)
Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As
Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
'Outlook Variablen
Private WithEvents moApplication As Outlook.Application
Private WithEvents moNameSpace As Outlook.NameSpace
Private WithEvents moActiveExplorer As Outlook.Explorer
Private msProgID As String
Private moContactsFolder As Outlook.MAPIFolder
Private WithEvents moContactItems As Outlook.Items
Private moCalendarFolder As Outlook.MAPIFolder
Private WithEvents moCalendarItems As Outlook.Items
Private moTaskFolder As Outlook.MAPIFolder
Private WithEvents moTaskItems As Outlook.Items
Private moDeleteFolder As Outlook.MAPIFolder
Private WithEvents moDeleteItems As Outlook.Items
Private obContactItem As Object
Private moContactItem As Object
Private obDistListItem As Object
Private moDistListItem As Object
Private obCalendarItem As Object
Private moCalendarItem As Object
Private obTasksItem As Object
Private moTasksItem As Object
'Office Variablen
Dim WithEvents objPropertiesButton As Office.CommandBarButton
Dim WithEvents objUserAdminButton As Office.CommandBarButton
Dim WithEvents objSynchButton As Office.CommandBarButton
Dim WithEvents objAktualButton As Office.CommandBarButton
Dim WithEvents objImportButton As Office.CommandBarButton
Dim WithEvents objExportButton As Office.CommandBarButton
Dim WithEvents objRegButton As Office.CommandBarButton
Dim WithEvents objHelpButton As Office.CommandBarButton
Private Sub AddinInstance_OnAddInsUpdate(custom() As Variant)
'On Error Resume Next
'DebugWrite "AddinInstance_OnAddInsUpdate"
Call Registry.DeleteDisable
End Sub
Private Sub AddinInstance_OnBeginShutdown(custom() As Variant)
'On Error Resume Next
'DebugWrite "AddinInstance_OnBeginShutdown"
Call Registry.DeleteDisable
End Sub
Private Sub AddinInstance_OnConnection(ByVal Application As Object, _
ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, _
ByVal AddInInst As Object, custom() As Variant)
Dim lngPID As Long
Dim lngThreadID As Long
Dim iDeleteAnswer As Integer
On Error Resume Next
Call Registry.DeleteDisable
If Application.Explorers.Count > 0 Then 'Outlook launched with UI
If Not TypeName(Application.ActiveExplorer) = "Nothing" Then
'Initialisieren
Set moApplication = Application
Set DB.OlApp = Application
Set moNameSpace = moApplication.GetNamespace("MAPI")
Set moActiveExplorer = Application.ActiveExplorer
msProgID = AddInInst.ProgId
'Folder für gelöschte Objekte
Set moDeleteFolder =
moNameSpace.GetDefaultFolder(olFolderDeletedItems)
Set moDeleteItems = moDeleteFolder.Items
'Licence.gbRegVersuch = False
Licence.gfalscherLizenzCode = False
Licence.gbLizenzAbgelaufen = False
Licence.gbZuVielUser = False
DB.gImport = False
DB.gExport = False
DB.gItemAdd = False
DB.gSynch = False
DB.gTransaktionsUeberpruefung = False
DB.gVerbindungFehler = False
DB.gbAddUser = False
DB.gbErsterUser = False
'Sprache festlegen
If
moApplication.Application.LanguageSettings.LanguageID(msoLanguageIDUI)
= 1031 Then
Sprachen.gsSprache = "deutsch"
ElseIf
moApplication.Application.LanguageSettings.LanguageID(msoLanguageIDUI)
= 1040 Then
Sprachen.gsSprache = "ital"
End If
Call Sprachen.InitMsgBox
'Version auslesen
If Left(moApplication.Version, 1) = "9" Then
DB.gOutlookVersion = 9
ElseIf Left(moApplication.Version, 2) = "10" Then
DB.gOutlookVersion = 10
ElseIf Left(moApplication.Version, 2) = "11" Then
DB.gOutlookVersion = 11
End If
'-------------------------------------------------------------------
'1.) Ist GAW aktiviert?
Call Registry.RegistryAktivAuslesen
If Registry.gsAktivString = "Nein" Then
DB.giDBProgrammAktiv = 0
DB.giAutoSynch = 0
'Kontakte
Call Registry.RegistryContactFolderIDAuslesen
If DB.gstrDBContactsFolderEntryID <> "" Then
Set moContactsFolder =
moNameSpace.GetFolderFromID(DB.gstrDBContactsFolderEntryID)
Set moContactItems = moContactsFolder.Items
End If
'Kalender
Call Registry.RegistryCalendarFolderIDAuslesen
If DB.gstrDBCalendarFolderEntryID <> "" Then
Set moCalendarFolder =
moNameSpace.GetFolderFromID(DB.gstrDBCalendarFolderEntryID)
Set moCalendarItems = moCalendarFolder.Items
End If
'Aufgaben
Call Registry.RegistryTaskFolderIDAuslesen
If DB.gstrDBTasksFolderEntryID <> "" Then
Set moTaskFolder =
moNameSpace.GetFolderFromID(DB.gstrDBTasksFolderEntryID)
Set moTaskItems = moTaskFolder.Items
End If
Call MenuBar
Exit Sub
Else
DB.giDBProgrammAktiv = 1
End If
'2.) DB Verbindung testen
If DBVerbindungstest(False) = False Then
'Keine Verbindung!!!!!
iDeleteAnswer = MsgBox(gsMsgBox(33), vbYesNo)
If iDeleteAnswer = vbYes Then
Call Registry.RegistryAktivSchreiben("Nein")
'Kontakte
Call Registry.RegistryContactFolderIDAuslesen
If DB.gstrDBContactsFolderEntryID <> "" Then
Set moContactsFolder =
moNameSpace.GetFolderFromID(DB.gstrDBContactsFolderEntryID)
Set moContactItems = moContactsFolder.Items
End If
'Kalender
Call Registry.RegistryCalendarFolderIDAuslesen
If DB.gstrDBCalendarFolderEntryID <> "" Then
Set moCalendarFolder =
moNameSpace.GetFolderFromID(DB.gstrDBCalendarFolderEntryID)
Set moCalendarItems = moCalendarFolder.Items
End If
'Aufgaben
Call Registry.RegistryTaskFolderIDAuslesen
If DB.gstrDBTasksFolderEntryID <> "" Then
Set moTaskFolder =
moNameSpace.GetFolderFromID(DB.gstrDBTasksFolderEntryID)
Set moTaskItems = moTaskFolder.Items
End If
DB.giDBProgrammAktiv = 0
DB.giAutoSynch = 0
MsgBox gsMsgBox(34)
Call MenuBar
Exit Sub
Else
'ODBC Einstellungen öffnen
Dim RetVal As Long
Dim SysDir As String
SysDir = Space$(256)
RetVal = modUserID.GetSystemDirectory(SysDir,
Len(SysDir))
If RetVal <> 0 Then
WebLink.ShellExec Left$(SysDir, RetVal) &
"\odbcad32.exe", vbNormalFocus
End If
DB.giDBProgrammAktiv = 0
DB.giAutoSynch = 0
'Kontakte
Call Registry.RegistryContactFolderIDAuslesen
If DB.gstrDBContactsFolderEntryID <> "" Then
Set moContactsFolder =
moNameSpace.GetFolderFromID(DB.gstrDBContactsFolderEntryID)
Set moContactItems = moContactsFolder.Items
End If
'Kalender
Call Registry.RegistryCalendarFolderIDAuslesen
If DB.gstrDBCalendarFolderEntryID <> "" Then
Set moCalendarFolder =
moNameSpace.GetFolderFromID(DB.gstrDBCalendarFolderEntryID)
Set moCalendarItems = moCalendarFolder.Items
End If
'Aufgaben
Call Registry.RegistryTaskFolderIDAuslesen
If DB.gstrDBTasksFolderEntryID <> "" Then
Set moTaskFolder =
moNameSpace.GetFolderFromID(DB.gstrDBTasksFolderEntryID)
Set moTaskItems = moTaskFolder.Items
End If
Call MenuBar
Exit Sub
End If
End If
'3.) Lizensierung
Call CheckLizenz
'4.) Menü
Call MenuBar
'5.) User Properties
If HoleUserProperties = False Then
If Licence.gfalscherLizenzCode = False And
Licence.gbZuVielUser = False And Licence.gbLizenzAbgelaufen = False
Then
Call frmAddUser.Show(vbModal)
End If
End If
DoEvents
'Kontakte
Call Registry.RegistryContactFolderIDAuslesen
If DB.gstrDBContactsFolderEntryID <> "" Then
Set moContactsFolder =
moNameSpace.GetFolderFromID(DB.gstrDBContactsFolderEntryID)
Set moContactItems = moContactsFolder.Items
End If
'Kalender
Call Registry.RegistryCalendarFolderIDAuslesen
If DB.gstrDBCalendarFolderEntryID <> "" Then
Set moCalendarFolder =
moNameSpace.GetFolderFromID(DB.gstrDBCalendarFolderEntryID)
Set moCalendarItems = moCalendarFolder.Items
End If
'Aufgaben
Call Registry.RegistryTaskFolderIDAuslesen
If DB.gstrDBTasksFolderEntryID <> "" Then
Set moTaskFolder =
moNameSpace.GetFolderFromID(DB.gstrDBTasksFolderEntryID)
Set moTaskItems = moTaskFolder.Items
End If
'Lizenz
If Licence.gfalscherLizenzCode = False And
Licence.gbZuVielUser = False And Licence.gbLizenzAbgelaufen = False
Then
DB.giDBProgrammAktiv = 1
Call frmSynch.Synchronisieren
Else
DB.giDBProgrammAktiv = 0
DB.giAutoSynch = 0
End If
'Benutzerrechte
If DB.gbErsterUser = True Then
DB.giAdmin = 1
End If
If DB.giAdmin = 0 Then
objUserAdminButton.Enabled = False
Else
objUserAdminButton.Enabled = True
End If
'Routinen für
Ersteinstiege--------------------------------------
If DB.gbAddUser = True Then
If DB.gbErsterUser = True Then
iDeleteAnswer = MsgBox(gsMsgBox(39), vbYesNo)
If iDeleteAnswer = vbYes Then
Call ExportSteuern
End If
DB.gbErsterUser = False
Else
iDeleteAnswer = MsgBox(gsMsgBox(40), vbYesNo)
If iDeleteAnswer = vbYes Then
Call SynchSteuern
End If
End If
DB.gbAddUser = False
End If
'----------------------------------------------------------------
End If
Else 'Outlook launched without UI
'Get Outlook ProcessID (same as current process ID since Add-In
runs in-process
lngPID = GetCurrentProcessId
lngThreadID = GetCurrentThreadId
If IsAddInMonProcess = False Then
'Launch AddInMonitor, supplying Add-In ProgID, Outlook PID,
ThreadID
Call Registry.RegistryAppPathAuslesen
Shell Registry.gApplicationPath & "\AddInMon.exe /n " &
AddInInst.ProgId _
& " /p " & lngPID & " /t " & lngThreadID
End If
End If
End Sub
Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode _
As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
'On Error Resume Next
If RemoveMode = ext_dm_UserClosed Then
'User shutdown removed COM Add-in
'Cleanup custom toolbars by deleting them
'Office
If Not objPropertiesButton Is Nothing Then
Set objPropertiesButton = Nothing
End If
If Not objUserAdminButton Is Nothing Then
Set objUserAdminButton = Nothing
End If
If Not objSynchButton Is Nothing Then
Set objSynchButton = Nothing
End If
If Not objAktualButton Is Nothing Then
Set objAktualButton = Nothing
End If
If Not objImportButton Is Nothing Then
Set objImportButton = Nothing
End If
If Not objExportButton Is Nothing Then
Set objExportButton = Nothing
End If
If Not objRegButton Is Nothing Then
Set objRegButton = Nothing
End If
If Not objHelpButton Is Nothing Then
Set objHelpButton = Nothing
End If
Else
'Host shutdown
End If
Call UnInitHandler
End Sub
Private Sub AddinInstance_OnStartupComplete(custom() As Variant)
'On Error Resume Next
'DebugWrite "AddinInstance OnStartupComplete"
End Sub
Private Sub moActiveExplorer_Close()
'On Error Resume Next
'Explorer Object
If Not moActiveExplorer Is Nothing Then
Set moActiveExplorer = Nothing
End If
If moApplication.Explorers.Count <= 1 Then
'Fenster
If Not frmAddUser Is Nothing Then
Unload frmAddUser
Set frmAddUser = Nothing
End If
If Not frmAddFolder Is Nothing Then
Unload frmAddFolder
Set frmAddFolder = Nothing
End If
If Not frmBenutzerverwaltung Is Nothing Then
Unload frmBenutzerverwaltung
Set frmBenutzerverwaltung = Nothing
End If
If Not frmExport Is Nothing Then
Unload frmExport
Set frmExport = Nothing
End If
If Not frmVorExport Is Nothing Then
Unload frmVorExport
Set frmVorExport = Nothing
End If
If Not frmImport Is Nothing Then
Unload frmImport
Set frmImport = Nothing
End If
If Not frmManSynch Is Nothing Then
Unload frmManSynch
Set frmManSynch = Nothing
End If
If Not frmManSynchTable Is Nothing Then
Unload frmManSynchTable
Set frmManSynchTable = Nothing
End If
If Not frmProperties Is Nothing Then
Unload frmProperties
Set frmProperties = Nothing
End If
If Not frmReaktivierung Is Nothing Then
Unload frmReaktivierung
Set frmReaktivierung = Nothing
End If
If Not frmReAktivUpdate Is Nothing Then
Unload frmReAktivUpdate
Set frmReAktivUpdate = Nothing
End If
If Not frmRegister Is Nothing Then
Unload frmRegister
Set frmRegister = Nothing
End If
If Not frmSynch Is Nothing Then
Unload frmSynch
Set frmSynch = Nothing
End If
Call UnInitHandler
End If
End Sub
Sub UnInitHandler()
On Error Resume Next
'Outlook
If Not obContactItem Is Nothing Then
Set obContactItem = Nothing
End If
If Not moContactItem Is Nothing Then
Set moContactItem = Nothing
End If
If Not obDistListItem Is Nothing Then
Set obDistListItem = Nothing
End If
If Not moDistListItem Is Nothing Then
Set moDistListItem = Nothing
End If
If Not obCalendarItem Is Nothing Then
Set obCalendarItem = Nothing
End If
If Not moCalendarItem Is Nothing Then
Set moCalendarItem = Nothing
End If
If Not obTasksItem Is Nothing Then
Set obTasksItem = Nothing
End If
If Not moTasksItem Is Nothing Then
Set moTasksItem = Nothing
End If
If Not moContactItems Is Nothing Then
Set moContactItems = Nothing
End If
If Not moDeleteItems Is Nothing Then
Set moDeleteItems = Nothing
End If
If Not moContactsFolder Is Nothing Then
Set moContactsFolder = Nothing
End If
If Not moDeleteFolder Is Nothing Then
Set moDeleteFolder = Nothing
End If
If Not moNameSpace Is Nothing Then
Set moNameSpace = Nothing
End If
If Not DB.OlApp Is Nothing Then
Set DB.OlApp = Nothing
End If
If Not moApplication Is Nothing Then
Set moApplication = Nothing
End If
End Sub
Maybe someone can help me?