VBA per Outlook 2000

[som]

Ciao a tutti sto provando ad utilizzare una macro in VBA per spostare la posta inviata su più account imap con Outlook 2000 ( non riesco a trovare un altro modo )...funziona ma ogni volta che viene attivata all'invio di un messaggio compare un fastidiosissimo warning:

"Un programma sta tentando di accedere agli indirizzi di posta elettronica memorizzati in Outlook. Consentire l'operazione? Se l'operazione non è prevista, potrebbe trattarsi di un virus, pertanto scegliere "No".

A cui bisogna rispondere Sì, altrimenti l'esecuzione viene bloccata.

Qualcuno riesce a darmi qualche dritta?

Public WithEvents myOlItems As Outlook.Items

Public Sub Application_Startup()

   ' Reference the items in the Inbox. Because myOlItems is declared
   ' "WithEvents" the ItemAdd event will fire below.
   Set myOlItems = Outlook.Session.GetDefaultFolder(olFolderSentMail).Items

End Sub

Private Sub myOlItems_ItemAdd(ByVal Item As Object)
   Dim olns As Outlook.NameSpace
   
   Dim ol As New Outlook.Application
   Set olns = ol.GetNamespace("MAPI")
   
   Dim oConItems As Outlook.Items
   Dim iNumItems As Integer
   
   Dim sSender As String
   
   Dim myCal As MAPIFolder
   
   ' SELEZIONE CARTELLA ORIGINE -> POSTA INVIATA
   Set oInboxItems = Application.GetNamespace("MAPI") _
                .GetDefaultFolder(FolderType:=olFolderSentMail).Items
   
   Set objTargetFolder1 = olns.Folders("IMAPACCOUNT1").Folders("Posta inviata")

   Set objTargetFolder2 = olns.Folders("IMAPACCOUNT2").Folders("Posta inviata")

   iNumItems = oInboxItems.Count

   For I = iNumItems To 1 Step -1
      Set objCurItem = oInboxItems.Item(I)
      If TypeName(objCurItem) = "MailItem" Then
          sSender = objCurItem.SenderName
          
          If sSender = "NOME1" Then
            objCurItem.Move objTargetFolder1
          ElseIf sSender = "NOME2" Then
            objCurItem.Move objTargetFolder2
          End If
          
      End If
   Next

   ' MsgBox "Finished moving items."

   Set objInboxItems = Nothing
   Set objTargetFolder1 = Nothing
   Set objTargetFolder2 = Nothing
   Set objNS = Nothing
   Set olns = Nothing
   Set ol = Nothing

End Sub