Solved

VBA, Excel and MAPI

Posted on 2004-10-13
26
1,291 Views
Last Modified: 2012-06-27
Hey,

Let me preface this message with "I AM NOT A PROGRAMMER!"...<sigh>

I've created a couple of VBA macros that will either send the active workbook via CDO (hitting a SMTP server) or Exchange (using Outlook objects).  I need advice:

CDO sends fine, but it leaves no "sent message" in my Sent Items - or at least it doesn't through my code.

The other way, DOES give me my sent message but it doesn't allow me to change the sender of the message.

I'm creating a tab in the workbook called Recipients - and in the first column I put email addresses, of contacts in Exchange/AD.

Ideally, I would like to have code that will save the workbook, create a session to a mailbox that I have permissions to, send the email and place the sent item in the special mailbox's Sent Items, leaving evidence that the sheet left our site.  I'll include the code I'm using that uses Outlook objects:

***************CODE*********************
Option Explicit

Sub SendWorkbook()
    Dim OutlookApp As Outlook.Application
    Dim MItem As Outlook.MailItem
    Dim Filename As String
    Dim EmailAddr As String
    Dim cell As Range
    Dim Subj As String
    Dim Recipient As String
    Dim Msg As String
    Dim Attach As Outlook.Attachment
    Dim Book As Workbook
   
    Filename = ThisWorkbook.Name
   
    ActiveWorkbook.Save
       
    Set OutlookApp = New Outlook.Application
For Each cell In Worksheets("Recipients").Range("A1:A100").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "*@*" Then
        Subj = Filename
   EmailAddr = cell.Value
   
    Msg = "See Attached File" & vbCrLf
    Msg = Msg & vbCrLf & vbCrLf
    Msg = Msg & "PA" & vbCrLf
    Msg = Msg & "615.555.1212"
   
       
    Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = EmailAddr
        .Subject = "PA Document - " & ActiveWorkbook.Name
        .Body = Msg
        .Attachments.Add ActiveWorkbook.FullName
        .Send
   
       
    End With
    End If
    Next
     
End Sub
**************END CODE******************
The above code works, but I have to be signed into the special mailbox's profile - which means little to me, but I'm dealing with people that think they're too important to learn HOW, but are just either too lazy or too...ummmm...stupid (did I say that out loud?).

Below is the code (I got off this site actually) using CDO, that I've been dinking with:

***************CODE*********************

Sub CDO_Send_Workbook()
' This example use late binding, you don't have to set a reference
' You must be online when you run the sub
    Dim iMsg As Object
    Dim iConf As Object
    Dim wb As Workbook
    Dim WBname As String
    Dim Flds As Variant
   
    ActiveWorkbook.Save
 
    Application.ScreenUpdating = False
    Set wb = ActiveWorkbook
'    Or use this Set wb = ThisWorkbook
'    WBname = wb.Name & " " & Format(Now, "dd-mm-yy") & ".xls"
'    wb.SaveCopyAs "C:/" & WBname
'    It will save a copy of the file in C:/ with a Date and Time stamp
 
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
 
        iConf.Load -1    ' CDO Source Defaults
        Set Flds = iConf.Fields
        With Flds
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.PA.local"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            .Update
        End With
 
    'Check out the Tips section if you want to change the .To and .TextBody
    With iMsg
        Set .Configuration = iConf
        .To = "anyone@IChoose.com"
        .CC = ""
        .BCC = ""
        .From = """PA Pricing"" <PAPricing@PATN.com>"
        .Subject = "This is a test"
        .TextBody = "This is the body text"
        .AddAttachment "C:/" & WBname
        ' You can add any file you want with this line .AddAttachment "C:/Test.txt"
        .Send
    End With
 
'    Kill "C:/" & WBname    'If you not want to delete the file you send delete this line
'    Set iMsg = Nothing
'    Set iConf = Nothing
'    Set wb = Nothing
'    Application.ScreenUpdating = True
End Sub

**************END CODE******************

Not being a Programmer, you can imagine how fried my brain is after two days of this.  Help is SO APPRECIATED!

paadmin (aka: Hank)

0
Comment
Question by:paadmin
  • 13
  • 9
  • 3
26 Comments
 

Author Comment

by:paadmin
ID: 12303424
Wow, woulda thunk someone would pounce on 500 points...

Have edited the Outlook Object code to include ".SentOnBehalfOfName = "PA Pricing Group" in the MItem section.  This takes care of the sender address there.  I also need code to put the mailitem in the PA Pricing Group mailbox, not mine (or whoever uses this macro).

Heard from one of the users, they want the email to open first, so they can edit the message, if they want to.

ack!

0
 
LVL 50

Accepted Solution

by:
Dave Brett earned 500 total points
ID: 12304450
Hi Hank

This question is probably a better fits inthe Excel or Outlook TA's

CDO for Windows 2000 uses the SMTP service on the machine to end mail, it bypasses Outlook. So I don't think you can use it to drop a mailitem in the Sent folder, a CC is the best you could do

With your Outlook Object code, you can display and edit the message by using Display ie

 With MItem
        .Display
        .To = EmailAddr
        .Subject = "PA Document - " & ActiveWorkbook.Name
        .Body = Msg
        .Attachments.Add ActiveWorkbook.FullName
        .Send
End With

I'm playing with the MailBox part, I need to find a multiple mailbox machine to run a test on

Cheers

Dave
0
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 12307823
Hank,

Please see my last (10 Oct 2004 9:13pm EDT) post to:
http://www.experts-exchange.com/Applications/MS_Office/Excel/Q_21162120.html

You might have an easier go of it if you use Excel's SendMail or Route methods, rather than try to
automate Outlook.

Regards,

Patrick
0
 

Author Comment

by:paadmin
ID: 12307960
brettdj - thanks for the tip on displaying the email - look forward to your solution on the mailbox issue.

matthewspatrick - I appreciate your suggestion, I looked at your code - I don't see where it places the sent item in a specific mailbox.  My assumption is it will put the mail item in the mailbox of the one that executes the macro.

Thanks,

Hank
0
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 12307983
Hank,

Using Route or SendMail will put:
1) a mail item in each recipient's Inbox
2) a mail item in the sender's Sent Items

Patrick
0
 

Author Comment

by:paadmin
ID: 12308199
Yes, my code will do that - will it send it to a mailbox that several people have access to?  More than one person will send these workbooks out.  but they all have to be from a generic address PAPricing@whatever.com, and all replies need to come back to that mailbox.

That's not what your telling me yours does, are you?

Hank
0
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 12309191
Hank,

In that case, neither SendMail nor Route will work, I'm afraid: neither method allows you to
reliably control who the "sender" is, and neither method allows you to control who the
default "Reply To:" is.

Patrick
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 12326171
Hank,

I've gone down a different route to attempt to use another mailbox - I think that this must be done with CDO rather than the Outlook object mode. You can install CDO as part of Outlook, there is a Micosoft KB article below on this

This code will currently let the user choose an Outllook profile when it runs - NB, Outlook must not be running or the profile choice won't be given. I tried running code to shutdown Outllook but I'm getting an ActiveX error on my home PC so I've commented it out

Rather than a profile you can log on to a mailbox dynamically, this is the commented out section
'objSession.Logon , , False, True, 0, "<Your Servername>" & vbLf & "<Your Mailbox>"

As I don't know your full mailbox details I've commented it out

This option will not display the message

Cheers

Dave


Sub Test()

'Requires the CDO 1.21 Reference
'see http://support.microsoft.com/default.aspx?scid=kb;en-us;171440
'It can be installed as an option with Outlook

    Dim OutlookApp As Outlook.Application
    Dim objSession As MAPI.Session, objMessage As MAPI.Message
    Dim Msg As String, Cel As Range

    ' On Error Resume Next
    ' Set OutlookApp = GetObject(, "Outlook.Application")
    ' OutlookApp.Quit
    ' Set OutlookApp = Nothing
    'On Error GoTo 0

    Set objSession = New MAPI.Session

    'Logon with a profile or dynamic mailbox
    'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnovba00/html/cDOpart1.asp

    'Profile option
    objSession.Logon , , True, False

    'dynamic mailbox
    'objSession.Logon , , False, True, 0, "<Your Servername>" & vbLf & "<Your Mailbox>"

    Filename = ThisWorkbook.Name
    ActiveWorkbook.Save

    ' Create a new mail item.

    Msg = "See Attached File" & vbCrLf
    Msg = Msg & vbCrLf & vbCrLf
    Msg = Msg & "PA" & vbCrLf
    Msg = Msg & "615.555.1212"

    For Each Cel In Worksheets("Recipients").Range("A1:A100").Cells.SpecialCells(xlCellTypeConstants)
        If Cel.Value Like "*@*" Then
            Set objMessage = objSession.Outbox.Messages.Add
            With objMessage
                .Subject = "PA Document - " & ActiveWorkbook.Name
                .Text = Msg
                .Recipients.Add Cel.Value
                .Attachments.Add ActiveWorkbook.FullName
                .Send
            End With
        End If
    Next
End Sub
0
 

Author Comment

by:paadmin
ID: 12333680
Hey Dave,

When I use the profile option...it does prompt me for the profile, I choose it and then the dialog goes away, but it never does anything.  Well, it DOES lock up Excel.  When I step through the macro, it goes all the way through the macro, but doesn't do anything...no email is sent.

When I try to use the dynamic mailbox option, using the following code:
     'objSession.Logon , , False, True, 0, "paexch-dc" & vbLf & "PA Pricing", I receive a Runtime error '13':  Type mismatch.

Any ideas...?

Hank
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 12337123
Hi Hank,

Can you please look at these questions

You dont get an Outlook warning than a program is trying to send email on your behalf? There is no new message in the Outbox when you log in?

If you look at the locals window in VBA then is there a valid recipient?

I'll look further at the dynamic mailbox issue on my work pc to see if I can understand the Type Mismatch

Cheers

Dave
0
 

Author Comment

by:paadmin
ID: 12338433
Dave,

I don't get an Outlook warning because I've created a public folder called Outlook Security Settings and posted a form that allows me to override that feature.

There is no message in the Outbox when I login.

I see nothing in the Locals window.

Hank
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 12346250
Hi Hank,

hmm, I'm running dry on this - I've tested the code on a second PC and it worked ok.

Are you logging into same profile each time you try the code?

When you debug the code does it reach this line
Set objMessage = objSession.Outbox.Messages.Add
and if so is there an object under objMessage?

Cheers

Dave
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:paadmin
ID: 12347238
Here's the code at that point in the macro:

    For Each Cell In Worksheets("Recipients").Range("A1:A100").Cells.SpecialCells(xlCellTypeConstants)
        If Cell.Value Like "*@*" Then
            Set objMessage = objSession.Outbox.Messages.Add
            With objMessage
                .Subject = "PA Document - " & ActiveWorkbook.Name
                .Text = Msg
                .Recipients.Add Cell.Value
                .Attachments.Add ActiveWorkbook.FullName
                .Send
            End With
        End If
    Next
End Sub

Hank
0
 

Author Comment

by:paadmin
ID: 12347262
PS...I can send from that profile manually.  And it's the one i use each time (in the macro)
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 12368761
And there is nothing under objMessage in Locals when you step through it?

My code did dimension the loop to work with Cel not Cell but that shouldn't be the problem
0
 

Author Comment

by:paadmin
ID: 12373349
When I step through it, information does show up there.  When I choose the profile I wanna use, that's when everything in the Locals Window goes away and Excel is locked up.

I changed the Cel to Cell...
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 12379462
If you change this line

objSession.Logon , , True, False
to
objSession.Logon , , False, False

The code will log onto the default profile automatically, does the mail get sent when you try this?

Cheers

Dave
0
 

Author Comment

by:paadmin
ID: 12380484
I recieve the following error:

     Run-time error '-2147221231 (80040111)':

      [Collaboration Data Objects - [MAPI_E_LOGON_FAILED(80040111)]]

This is a pain in the keester huh?

Hank
0
 

Author Comment

by:paadmin
ID: 12380952
In the Locals Window, the following are the only lines that show any information...the other lines have an error in them ( example   : AddressLists : < [Collaboration Data Objects - [MAPI_E_NOT_INITIALIZED(80040605)]]> : Variant)

- : objSession :  : Session/Session
    : Application : "Collaboration Data Objects" : Variant/String
    : Class : 0 : Variant/Long
    : OperatingSystem : "Microsoft Windows NT(TM) 5.1.2600" : Variant/String
    : Version : "1.21" : Variant/String

  : objMessage : Nothing : Message
  : Msg : "" : String
  : Cell : Nothing : Range
  : Filename : Empty : Variant/Empty

AND HERE IS THE CODE AGAIN, JUST IN CASE I'VE FAT FINGERED SOMETHING:

Sub Test()

'Requires the CDO 1.21 Reference
'see http://support.microsoft.com/default.aspx?scid=kb;en-us;171440
'It can be installed as an option with Outlook

    Dim OutlookApp As Outlook.Application
    Dim objSession As MAPI.Session, objMessage As MAPI.Message
    Dim Msg As String, Cell As Range

    ' On Error Resume Next
    ' Set OutlookApp = GetObject(, "Outlook.Application")
    ' OutlookApp.Quit
    ' Set OutlookApp = Nothing
    'On Error GoTo 0

    Set objSession = New MAPI.Session

    'Logon with a profile or dynamic mailbox
    'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnovba00/html/cDOpart1.asp

    'Profile option
    'objSession.Logon , , False, False

    'dynamic mailbox
    objSession.Logon , , False, True, 0, "PAEXCH-DC" & vbLf & "PA Pricing Group"

    Filename = ThisWorkbook.Name
    ActiveWorkbook.Save

    ' Create a new mail item.

    Msg = "See Attached File" & vbCrLf
    Msg = Msg & vbCrLf & vbCrLf
    Msg = Msg & "PA" & vbCrLf
    Msg = Msg & "615.259.0295"

    For Each Cell In Worksheets("Recipients").Range("A1:A100").Cells.SpecialCells(xlCellTypeConstants)
        If Cell.Value Like "*@*" Then
            Set objMessage = objSession.Outbox.Messages.Add
            With objMessage
                .Subject = "PA Document - " & ActiveWorkbook.Name
                .Text = Msg
                .Recipients.Add Cell.Value
                .Attachments.Add ActiveWorkbook.FullName
                .Send
            End With
        End If
    Next
End Sub

I'm appreciating your help man...truly
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 12381142
Hi Hank,

Ok, looks like the MAPI session isn't logging on

Accordong to
http://support.microsoft.com/?kbid=181739

CAUSE
Here are four possible reasons for this error:
1. You are trying to access a mailbox that does not exist or you are using invalid logon information.
2. You have insufficient rights on the Exchange mailbox.
3. If you are running code in an Active Server Page (ASP), you may have insufficient rights on the Microsoft Internet Information Server (IIS) computer.
4. You are relying on password synchronization in Microsoft Internet Information Server (IIS) version 4.0 to authenticate the Anonymous User specified in IIS.

Do any of the above look plausibile?

Cheers

Dave
0
 

Author Comment

by:paadmin
ID: 12381319
Well,

1.  The mailbox exists
2.  and I have full rights to it
3.  I am domain admin, so I have the rights needed - however, I am not running this from ASP, I'm running it from VBA in Excel
4.  IIS isn't involved.
0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 12381601
hmm,

I just tried the

  objSession.Logon , , False, False
on my pc and this time I got the same error as you. Previously this code had worked fine. I switched back to
  objSession.Logon , , True, False
to show the Profile names and then it worked once I selected my profile

I'll keep googling

Cheers

Dave

0
 

Author Comment

by:paadmin
ID: 12735480
Dan,

You're right brettdj has done a lot of work here.  But an acceptable solution was not provided by anyone.  I'm still using my own code.

0
 
LVL 50

Expert Comment

by:Dave Brett
ID: 12735639
Well you did get the Display bit done :)

This one bugged me, sorry we couldn't finish it

Dave

0
 

Author Comment

by:paadmin
ID: 12735681
Yes...the Display thing worked but was unacceptable to the user.

I really appreciate the effort you put forth...and would like to offer you the points.

Thanks Dave - and Happy Holidays man!
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Suggested Solutions

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now