Consulting

Results 1 to 16 of 16

Thread: Solved: Bypassing Outlook Security Warning

  1. #1
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location

    Solved: Bypassing Outlook Security Warning

    I wrote a macro to loop through all sub folders in a selected folder and to save the emails found to the hard drive (while keeping the same file heirarchy).

    Some of my coworkers have 1000s of emails that they want to save, but the huge pst files become hard to manage. So this way they can have the files in a more familiar folder system and burn them to a CD easily.

    It works fine, but it does take a while to run. I get the warning shown below and that is fine, but the longest time that I can set to allow access is 10 minutes which is not enough time. I would like to avoid having the user have to allow access several times.

    So is there a simple way to just disable this feature (at least temporarily)? Or can the 10 minute setting be changed somewhere (in the registry perhaps)?

    Thanks

    Jake

  2. #2
    VBAX Master Killian's Avatar
    Joined
    Nov 2004
    Location
    London
    Posts
    1,132
    Location
    Hi Jake

    I don't think there is a way of disabling it, since it's the dreaded "Outlook Object Model Guard" which by coincedence, I posted about earlier today (here).

    Although I'm a bit confused since I wouldn't expect to see it as a result of just saving mail messages...
    e.g this shouldn't trigger it:[VBA]Dim m As MailItem

    Set m = CreateItem(olMailItem)
    m.SaveAs "c:\temp\test.msg", olMSG[/VBA]
    K :-)

  3. #3
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    Yea:

    [vba]
    Set mItem = SubFolder.Items(j)
    mItem.SaveAs StrFile, 3
    [/vba]

    I had mItem as Object, instead of MailItem, but changing the data type did nothing.

  4. #4
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    Here is the code in its entirety. Perhaps there is something that I am doing that triggers the warning, but there is an alternative that would not?

    [vba]
    Option Explicit

    Sub SaveAllEmails_ProcessAllSubFolders()

    Dim i As Long
    Dim j As Long
    Dim n As Long
    Dim StrSubject As String
    Dim StrName As String
    Dim StrFile As String
    Dim StrReceived As String
    Dim StrSavePath As String
    Dim StrFolder As String
    Dim StrFolderPath As String
    Dim StrSaveFolder As String
    Dim Prompt As String
    Dim Title As String
    Dim iNameSpace As NameSpace
    Dim myOlApp As Outlook.Application
    Dim SubFolder As MAPIFolder
    Dim mItem As Object
    Dim FSO As Object
    Dim ChosenFolder As Object
    Dim Folders As New Collection
    Dim EntryID As New Collection
    Dim StoreID As New Collection

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set myOlApp = CreateObject("Outlook.Application")
    Set iNameSpace = myOlApp.GetNamespace("MAPI")
    Set ChosenFolder = iNameSpace.PickFolder
    If ChosenFolder = "" Then
    GoTo ExitSub:
    End If

    Prompt = "Please enter the path to save all the emails to."
    Title = "Folder Specification"
    StrSavePath = BrowseForFolder
    If StrSavePath = "" Then
    GoTo ExitSub:
    End If
    If Not Right(StrSavePath, 1) = "\" Then
    StrSavePath = StrSavePath & "\"
    End If

    Call GetFolder(Folders, EntryID, StoreID, ChosenFolder)
    If Not FSO.FolderExists("C:\Data\") Then
    FSO.CreateFolder ("C:\Data\")
    End If
    If Not FSO.FolderExists("C:\Data\Mail") Then
    FSO.CreateFolder ("C:\Data\Mail")
    End If

    For i = 1 To Folders.Count
    StrFolder = StripIllegalChar(Folders(i))
    n = InStr(3, StrFolder, "\") + 1
    StrFolder = Mid(StrFolder, n, 256)
    StrFolderPath = StrSavePath & StrFolder & "\"
    StrSaveFolder = Left(StrFolderPath, Len(StrFolderPath) - 1) & "\"
    If Not FSO.FolderExists(StrFolderPath) Then
    FSO.CreateFolder (StrFolderPath)
    End If

    Set SubFolder = myOlApp.Session.GetFolderFromID(EntryID(i), StoreID(i))
    On Error Resume Next
    For j = 1 To SubFolder.Items.Count
    Set mItem = SubFolder.Items(j)
    StrReceived = ArrangedDate(mItem.ReceivedTime)
    StrSubject = mItem.Subject
    StrName = StripIllegalChar(StrSubject)
    StrFile = StrSaveFolder & StrReceived & "_" & StrName & ".msg"
    StrFile = Left(StrFile, 256)
    mItem.SaveAs StrFile, 3
    Next j
    On Error GoTo 0
    Next i

    ExitSub:

    End Sub

    Function StripIllegalChar(StrInput)

    Dim RegX As Object

    Set RegX = CreateObject("vbscript.regexp")
    RegX.Pattern = "[\" & Chr(34) & "\!\@\#\$\%\^\&\*\(\)\=\+\|\[\]\{\}\`\'\;\:\<\>\?\/\,]"
    RegX.IgnoreCase = True
    RegX.Global = True
    StripIllegalChar = RegX.Replace(StrInput, "")

    ExitFunction:

    Set RegX = Nothing

    End Function

    Function ArrangedDate(StrDateInput)

    Dim StrFullDate As String
    Dim StrFullTime As String
    Dim StrAMPM As String
    Dim StrTime As String
    Dim StrYear As String
    Dim StrMonthDay As String
    Dim StrMonth As String
    Dim StrDay As String
    Dim StrDate As String
    Dim StrDateTime As String
    Dim RegX As Object

    Set RegX = CreateObject("vbscript.regexp")

    If Not Left(StrDateInput, 2) = "10" And _
    Not Left(StrDateInput, 2) = "11" And _
    Not Left(StrDateInput, 2) = "12" Then
    StrDateInput = "0" & StrDateInput
    End If

    StrFullDate = Left(StrDateInput, 10)

    If Right(StrFullDate, 1) = " " Then
    StrFullDate = Left(StrDateInput, 9)
    End If

    StrFullTime = Replace(StrDateInput, StrFullDate & " ", "")

    If Len(StrFullTime) = 10 Then
    StrFullTime = "0" & StrFullTime
    End If

    StrAMPM = Right(StrFullTime, 2)
    StrTime = StrAMPM & "-" & Left(StrFullTime, 8)
    StrYear = Right(StrFullDate, 4)
    StrMonthDay = Replace(StrFullDate, "/" & StrYear, "")
    StrMonth = Left(StrMonthDay, 2)
    StrDay = Right(StrMonthDay, Len(StrMonthDay) - 3)
    If Len(StrDay) = 1 Then
    StrDay = "0" & StrDay
    End If
    StrDate = StrYear & "-" & StrMonth & "-" & StrDay
    StrDateTime = StrDate & "_" & StrTime
    RegX.Pattern = "[\:\/\ ]"
    RegX.IgnoreCase = True
    RegX.Global = True

    ArrangedDate = RegX.Replace(StrDateTime, "-")

    ExitFunction:

    Set RegX = Nothing

    End Function

    Sub GetFolder(Folders As Collection, _
    EntryID As Collection, _
    StoreID As Collection, _
    Fld As MAPIFolder)

    Dim SubFolder As MAPIFolder

    Folders.Add Fld.FolderPath
    EntryID.Add Fld.EntryID
    StoreID.Add Fld.StoreID
    For Each SubFolder In Fld.Folders
    GetFolder Folders, EntryID, StoreID, SubFolder
    Next SubFolder

    ExitSub:

    Set SubFolder = Nothing

    End Sub

    Function BrowseForFolder(Optional OpenAt As String) As String

    Dim ShellApp As Object

    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0

    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
    If Left(BrowseForFolder, 1) = ":" Then
    BrowseForFolder = ""
    End If
    Case Is = "\"
    If Not Left(BrowseForFolder, 1) = "\" Then
    BrowseForFolder = ""
    End If
    Case Else
    BrowseForFolder = ""
    End Select

    ExitFunction:

    Set ShellApp = Nothing

    End Function
    [/vba]

  5. #5
    Moderator VBAX Guru Ken Puls's Avatar
    Joined
    Aug 2004
    Location
    Nanaimo, BC, Canada
    Posts
    4,001
    Location
    Jake,

    Have you tried Outlook redemption? I think that it's license allows internal/development use, although you'd have to check on that. Alternately, there is a program called Clickyes that I've used in the past. It works, but it does pause for a while to allow the warning to be cleared.

    Alternately, can you run the routine from within Outlook itself? The warning is thrown because you're creating a new instance from outside. I don't think you'd get hit if you did it in Outlook alone.
    Ken Puls, CMA - Microsoft MVP (Excel)
    I hate it when my computer does what I tell it to, and not what I want it to.

    Learn how to use our KB tags! -||- Ken's Excel Website -||- Ken's Excel Forums -||- My Blog -||- Excel Training Calendar

    This is a shameless plug for my new book "RibbonX - Customizing the Office 2007 Ribbon". Find out more about it here!

    Help keep VBAX clean! Use the 'Thread Tools' menu to mark your own threads solved!





  6. #6
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    I have run the macro from Outlook Tools | Macro | Macros... and also directly from the VBE, but I get the warning regardless.

    Thanks

  7. #7
    VBAX Master Killian's Avatar
    Joined
    Nov 2004
    Location
    London
    Posts
    1,132
    Location
    Indeed, Ken is right - it's the creation of the new Outlook instance that's triggering the Object Model Guard (which I just noticed has the most appropriate acronym of all time - OMG )
    Since you're running this fron Outlook, there's no need to create a new object, you can just assign the existing app[VBA]'Set myOlApp = CreateObject("Outlook.Application")
    'should be
    Set myOlApp = Application[/VBA]Making that change should prevent the message
    K :-)

  8. #8
    VBAX Master TonyJollans's Avatar
    Joined
    May 2004
    Location
    Norfolk, England
    Posts
    2,291
    Location
    Despite the fact that it appears in many examples all over the web,[vba]Set myOlApp = CreateObject("Outlook.Application")[/vba]will not create a new instance if there is already one running and, in a macro in Outlook, does exactly the same as[vba]Set myOlApp = Application[/vba]

    I have to disagree with the others, I'm afraid, I don't think you can stop the message, just reply to it - manually or with ClickYes or equivalent.
    Enjoy,
    Tony

    ---------------------------------------------------------------
    Give a man a fish and he'll eat for a day.
    Teach him how to fish and he'll sit in a boat and drink beer all day.

    I'm (slowly) building my own site: www.WordArticles.com

  9. #9
    VBAX Master Killian's Avatar
    Joined
    Nov 2004
    Location
    London
    Posts
    1,132
    Location
    Quote Originally Posted by TonyJollans
    Despite the fact that it appears in many examples all over the web,[vba]Set myOlApp = CreateObject("Outlook.Application")[/vba]will not create a new instance if there is already one running and, in a macro in Outlook, does exactly the same as[vba]Set myOlApp = Application[/vba]
    Indeed, Outlook is a single instance app so CreateObject returns a reference to an existing session but while the two methods return the same object, they don't appear to do the same thing i.e. the method differs.
    My theory is that it is the method that CreateObject employs (making an external check for the running instance and coming back from "outside" to reference it) that appears to be triggering the OMG

    My evidence to support the threoy is that when I change Jake's code to "Set myOlApp = Application" I don't get the message. (OL2003, WinXP sp2)
    Presumably, setting the object variable directly to "Application" doesn't make any external call to the OMG isn't disturbed. It's effectively the same difference between early and late binding.

    This is all speculation, since I can't find any documentation to support it. As Tony rightly points out, CreateObject is used in just about every example published, including those by M$, but frankly, that doesn't make it right.
    If you can access an object directly to set a variable, I can't think of any reason why you would need to make a function call to return it instead.

    Having said that, different versions of OL (or different service packs/security updates) may be effecting the outcome.
    K :-)

  10. #10
    VBAX Master TonyJollans's Avatar
    Joined
    May 2004
    Location
    Norfolk, England
    Posts
    2,291
    Location
    Hi Killian,

    You are correct - just checked (OL 2003, XP Pro SP1). Very interesting.

    The message is triggered by the SaveAs and, according to Help you've got no choice in the matter. Clearly that is not quite correct but I don't understand what happens.
    Enjoy,
    Tony

    ---------------------------------------------------------------
    Give a man a fish and he'll eat for a day.
    Teach him how to fish and he'll sit in a boat and drink beer all day.

    I'm (slowly) building my own site: www.WordArticles.com

  11. #11
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    Ok, so there may be hope. I'll check this in a few hours when I get into work.

    You know I didn't even think about why CreateObject was being used. I don't code in OL much (thankfully).

    Thanks

  12. #12
    Moderator VBAX Guru Ken Puls's Avatar
    Joined
    Aug 2004
    Location
    Nanaimo, BC, Canada
    Posts
    4,001
    Location
    Quote Originally Posted by Killian
    ...the Object Model Guard (which I just noticed has the most appropriate acronym of all time - OMG )
    ROFL! I never noticed that!
    Ken Puls, CMA - Microsoft MVP (Excel)
    I hate it when my computer does what I tell it to, and not what I want it to.

    Learn how to use our KB tags! -||- Ken's Excel Website -||- Ken's Excel Forums -||- My Blog -||- Excel Training Calendar

    This is a shameless plug for my new book "RibbonX - Customizing the Office 2007 Ribbon". Find out more about it here!

    Help keep VBAX clean! Use the 'Thread Tools' menu to mark your own threads solved!





  13. #13
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    Removing the CreateObject did the trick.

    Thanks

  14. #14
    Moderator VBAX Guru Ken Puls's Avatar
    Joined
    Aug 2004
    Location
    Nanaimo, BC, Canada
    Posts
    4,001
    Location
    Sorry Jake. In a roundabout way, that's what I was trying to suggest. I guess I forgot to turn on my "option explicit".

    Glad you got it sorted.
    Ken Puls, CMA - Microsoft MVP (Excel)
    I hate it when my computer does what I tell it to, and not what I want it to.

    Learn how to use our KB tags! -||- Ken's Excel Website -||- Ken's Excel Forums -||- My Blog -||- Excel Training Calendar

    This is a shameless plug for my new book "RibbonX - Customizing the Office 2007 Ribbon". Find out more about it here!

    Help keep VBAX clean! Use the 'Thread Tools' menu to mark your own threads solved!





  15. #15
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    I don't use outlook much but Jakes script from post 4 works great and I can see a use for it..could you add it to the kb?
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

  16. #16

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •