Bypassing the Outlook security box (by accident LOL)

[Mike375]

The following code is eliminating the Yes/No box. It is also acting like SMTP as there is nothing in the Send box and the speed is the same as when I use SMTP. Other code which I have for Outlook brings up the Yes/No and slow to send. The main difference is that code producing the normal Yes/No is not dynamic in reference to the Word doc file.

In both case the Word doc forms the body of the email and the attachment

Dim OutMail As Object
Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
 
 
    Dim wd As Word.Application
Dim doc As Word.Document
Dim Itm As Object
Dim ID As String
Dim blnWeOpenedWord As Boolean
On Error Resume Next
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
blnWeOpenedWord = True
End If
Set doc = wd.Documents.Open _
(FileName:="c:\StoreLettersGarner\" & Format([Forms]![PrintAndClose]![AA12]))
 
doc.wdSaveChanges
Set Itm = doc.MailEnvelope.Item
With Itm
.To = Forms!PrintAndClose!A4
.Subject = [Forms]![PrintAndClose]![Text446]
 
   .Attachments.Add ("C:\StoreLettersGarner\" & Format([Forms]![PrintAndClose]![AA12]))
 
 
 
 
.Save
ID = .EntryID
End With
 
 
Set Itm = Nothing
 
Set Itm = Outlook.Application.Session.GetItemFromID(ID)
Itm.Send
doc.Close wdDoNotSaveChanges
If blnWeOpenedWord Then
wd.Quit
End If
Set doc = Nothing
Set Itm = Nothing
Set wd = Nothing

 

[Mr. B]

BradF,

If you don't mind, what environment(s) did you test your code in? WindowsXP, Vista? Access verson?

Thanks,

 

[Mike375]

XP Pro and Office 2003

I use Outlook Express as my default email.

 

[Mr. B]

Mike,

Thanks for the info. I am planning to test you code next week.

 

[Mike375]

One other bit of info I will add which might ave some bearing but probably not.

I was making this yesterday for a prospect. First up I made it for SMTP which all worked and then made it in Outlook. Outlook ran into the problem where it does not function but the code runs through to the end. I have had that before at times. So I reinstalled MS Office (as a reinstall/repair, not removing and putting back on). I then went to a DB I have which among other things I use to test Outlook. Before the reinstall it did not work but after reinstall it worked and up came the Yes/No box.

I then went to the DB to test what I had made in Outlook and I thought it had not worked. When I test this stuff I have an OnClick on a textbox and wait for the cursor to return. The cursor returned but no Yes/No just as before the reinstall. I then opened my email and in came the email. So I repeated several times and same story. My test Outlook produces the Yes/No.

When I get some time today or tomorrow I will change my test Outlook so the references to Word are dynamic as that is about the only difference. Both of them add the Word doc as an attachment and as the body of the email.

One other difference is my test Outlook first opens the Word doc and inserts data into book marks, saves the doc and uses it and in the one block of code. The new version I made that is not producing the Yes/No has the email part done as a separate block of code. That is, the Word doc is opened by other code and data inserted to bookmarks, the Word doc saved with a date/time/client name stamp and the name of the resulting file placed into a text box. Then the Outlook uses that file name for the attachment and body of the email.

However, I did test it so as to do it in one run.

DoCmd.RunMacro "Macro110ForOutlook", , ""
DoCmd.Close acForm, "LN"
DoCmd.RunMacro "Macro70", , ""

The first macro is on a tabular form that lists the various Word doc file names. It sets the value of a text box on the main form with the selected file name. The tabular form is then closed. Macro 70 is calling the module which has the code I posted. It goes straight through without the Yes/No and nothing in the Send box.

It almost appears as if SMTP is being used even though Outlook is being called.

PS. I just tested it again in case something changed overnight. Sunday morning in Australia. It did the same.

 

[darbid]

I was just reading something in another forum and came across this which might also avoid the security warning.

Set objExplorer = objOutlook.Explorers.Add(objNameSpace.Folders(1), 0)
objExplorer.CommandBars.FindControl(, 1695).Execute

I am assuming this is the send button in the Outlook toolbar.

 

[Mike375]

I was just reading something in another forum and came across this which might also avoid the security warning.

Set objExplorer = objOutlook.Explorers.Add(objNameSpace.Folders(1), 0)
objExplorer.CommandBars.FindControl(, 1695).Execute

I am assuming this is the send button in the Outlook toolbar.

Interesting. Something else to try.

I just noticed something else about the code I used. Although I have Outlook set to leave message on Server that is not happening with the code. If I email myself manually and receive I can open Outlook Express and in it comes. If I use the other code that requires Yes/No then it will also be on Outlook Express.

With the code I posted the email is in the Inbox as soon as Outlook is opened and the Server is cleared

 

[darbid]

Mike are you still playing around with this.

I have had (at least for me) a huge breakthrough and understand a little more. Theoretically this seems old school but I could not find any explanations.

I already have an Outlook add-in. I made a simple COM addin with VB6 and it works in Outlook 2003/2007. So I thought I could add something to it.

1. First up you need to follow some advice here and add Application.COMAddIns.Item("O2LTT2I.Connect").Object = Me to the on connect routine of the addin
   http://support.microsoft.com/?kbid=240768
2. Then I created a public function like this in the addin code which calls a function in my test database db2 and passes by ref the outlook object of the addin (THE HOLY GRAIL OF OBJECTS)

   Public Sub TestOutlook()
   
   Dim appAccess As Object 'late binding of the MSAccess object
   Dim objDBase As Object 'late binding of LuTTool MDB
   
   Set appAccess = GetObject(, "Access.Application")
   
   If Err.Number = 429 Then
       Err.Clear
       MsgBox getMessage("mdbclosed", user_language), vbCritical, "LuTTool - for Outlook"
       Exit Sub
   End If
   
   Set objDBase = appAccess.CurrentDb
   
   If Left(Dir(objDBase.Name), 3) = "db2" Then
       appAccess.Run "fromoutlook", out_App
   End If
   
   Set appAccess = Nothing
   Set objDBase = Nothing
   
   
   End Sub

3. Then this fromoutlook function is simply

   Public myOl As Outlook.Application
   Public Function fromoutlook(ByRef app_out As Outlook.Application)
        Set myOl = app_out
   End Function

4. To get this all started from Access you need something like this

   Private Sub Command0_Click()
   
   Dim olApp As Outlook.Application
   
    Set olApp = GetObject(, "Outlook.Application")
   
   Set myObj = olApp.COMAddIns.Item("O2LTT2I.Connect").Object
   
   myObj.TestOutlook
   End Sub

So if you need the object you just call Command0 in this example. This calls the procedure in the add-in which then sends the outlook object to Access.

Now if you always use myOl in your Access code to get any other objects like MailItems or AppointmentItems or Recipients you will not get security prompts.

The only thing that I am not sure about yet is making sure all these objects are destroyed properly so that outlook closes and is not hung up by the add.in

 

[Mike375]

Mike are you still playing around with this.

I will be in a few days or so. I have just completed a lot of stuff to deal with incoming and in particular bounce backs from bad addresses as opposed to the outgoing.

I am having a break from the screen for a week or so and will look at what you have just posted. If you don't have a break from this stuff you get giddy and make lots of mistakes

The attached and following Outlook macro might be of use to you. All the combinations of bounce back I tried all produced an attachment with the bounce back and the attachment is the original email. So first up I use an Outlook macro to put those attachments in a folder called Email attachments.

The following Outlook macro then copies the resuling mdg files from Email Attachments to Outlook folder Bounces. The attached mdb Access opens and runs Macro1 in the xls file then as you can see the crude Access DB can link the bounce backs to a customer list. It is a bit rough at the moment as I have not cleaned up but it works. For a proper working version vbNormalFocus needs to be changed to vbHide. I could find no other way except SendKeys to do the copy and paste. Copying msg files back to Outlook results in something where the Outlook objects won't work. I believe you can use Redemption for Outlook but I prefer to avoid third party stuff when I make something for someone. I am not sure but I think Outlook 2007 will allow msg files to be copied to Outlook in the normal copyi file manner.

PS. You will noticed in the Access code that the xls file is first copied from another folder. I did because I found saving the excel file was needed and so the copy across copies a an excel file that only has the macro in it.

Call Shell("explorer.exe c:\Email Attachments", vbNormalFocus)
 
 
   SendKeys "^(a)", True
    SendKeys "^(a)", True
   SendKeys "^(c)", True
    SendKeys "^(c)", True
 
 
 
    Dim myolApp As Outlook.Application
    Dim myNameSpace As Outlook.NameSpace
    Dim myFolder As Outlook.MAPIFolder
    Dim found As Boolean
    Dim strFolderName As String
 
 
    strFolderName = "Bounces"
 
    found = False
    Set myolApp = GetObject(, "Outlook.Application")
    Set myNameSpace = myolApp.GetNamespace("MAPI")
    For i = 1 To (myNameSpace.Folders.Count)
        For j = 1 To (myNameSpace.Folders(i).Folders.Count)
            If myNameSpace.Folders(i).Folders(j) = strFolderName Then
                Set Application.ActiveExplorer.CurrentFolder = _
                    myNameSpace.Folders(i).Folders(j)
                Exit For
            End If
        Next
        If found = True Then Exit For
    Next
    Set myolApp = Nothing
    Set myNameSpace = Nothing
 
 
SendKeys "%{F4}"
 
  SendKeys "^(v)", True
 
   SendKeys "^(v)", True