• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1460
  • Last Modified:

VBA, Excel and MAPI

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
paadmin
Asked:
paadmin
  • 13
  • 9
  • 3
1 Solution
 
paadminAuthor Commented:
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
 
DaveCommented:
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
 
Patrick MatthewsCommented:
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
Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

 
paadminAuthor Commented:
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
 
Patrick MatthewsCommented:
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
 
paadminAuthor Commented:
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
 
Patrick MatthewsCommented:
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
 
DaveCommented:
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
 
paadminAuthor Commented:
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
 
DaveCommented:
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
 
paadminAuthor Commented:
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
 
DaveCommented:
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
 
paadminAuthor Commented:
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
 
paadminAuthor Commented:
PS...I can send from that profile manually.  And it's the one i use each time (in the macro)
0
 
DaveCommented:
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
 
paadminAuthor Commented:
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
 
DaveCommented:
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
 
paadminAuthor Commented:
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
 
paadminAuthor Commented:
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
 
DaveCommented:
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
 
paadminAuthor Commented:
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
 
DaveCommented:
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
 
paadminAuthor Commented:
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
 
DaveCommented:
Well you did get the Display bit done :)

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

Dave

0
 
paadminAuthor Commented:
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

  • 13
  • 9
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now