Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations IamaSherpa on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Outlook Macro in ThisOutlookSession Not staying signed due to modification...

Status
Not open for further replies.

lameid

Programmer
Jan 31, 2001
4,212
US
The subject about says it all.

I have macros saved in the default ThisOutlookSession module. I sign it. Exit Outlook. Open Outlook and it says the code has been modified, doesn't match the signature and that macros will be disabled. This is an Exchange hosted mailbox. The company I work at has a digital certificate server and I acquired mine there.

While I do have multiple clients that may hit my mailbox, it is only when I sign in and I am careful when testing not to access the mailbox between signed machine sessions which is where I ideally intend to exclusively use my mailbox. Meanwhile the code is becoming disabled on that machine because of the invalidated signature.

The code has a simple purpose. Put the received date of the message in the user field so I can group on it and then format received as time. Obviously I want it to run all the time.

I also realize it ideally should be running on different events since it is Exchange hosted and the event may not process correctly for big batches, hence my secondary procedure to fix but when I read about the issue I quickly put that on my to do list for if I ever get bored and is something I have to look up as it looked slightly involved...

My current thought is that maybe a server side security process is messing with it as at a glance it looks fine. This is an involved issue so my IT department will likely take a month to route the ticket appropriately, hence I am here hoping for some thoughts so I can steer them.

More on the outlook dialog and code below.

Outlook dialog excerpt said:
Microsoft Office has identified a potential security concern.

Warning: The Digital signature has been tampered with after the content was signed. This content cannot be trusted.

Code:
Option Explicit

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  ' default local Inbox
  Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)

  On Error GoTo ErrorHandler
  Dim dtReceived As Date
  Dim objProp As Outlook.UserProperty
    
  Select Case TypeName(Item)
    Case "ReportItem" 'NDR's - Non Delivery Reports
        dtReceived = Item.CreationTime 'Looks like this is the "Received Date"
    Case Else 'MailItem and MeetingItem I definitely saw working
      dtReceived = Item.ReceivedTime
  End Select
  'MsgBox "Date Received is" & dtReceived 'Yes it is running
 'Property added below needs added to inbox view if you want to see or group on it
  Set objProp = Item.UserProperties.Add("ReceivedDateOnly", olDateTime, True)
  objProp.Value = DateSerial(Year(dtReceived), Month(dtReceived), Day(dtReceived))
  Item.Save 'item needs saved now that it has been updated
ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub


Sub FixItems()
  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Dim olItems As Outlook.Items
  Dim Item As Object
  'Dim ReportItem As Outlook.ReportItem
  
  Dim dtReceived As Date
  Dim objProp As Outlook.UserProperty
  
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  ' default local Inbox
  Set olItems = objNS.GetDefaultFolder(olFolderInbox).Items
  
  For Each Item In olItems
    Select Case TypeName(Item)
      Case "ReportItem" 'NDR's - Non Delivery Reports
        dtReceived = Item.CreationTime 'Looks like this is the "Received Date"
      Case Else 'MailItem and MeetingItem I definitely saw working
        'Debug.Print TypeName(Item)
        dtReceived = Item.ReceivedTime
    End Select
    
    Set objProp = Item.UserProperties.Add("ReceivedDateOnly", olDateTime, True)
    objProp.Value = DateSerial(Year(dtReceived), Month(dtReceived), Day(dtReceived))
    Item.Save 'item needs saved now that it has been updated
SkipLoop:
  Next
  
End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top