Send email via a certain a/c?

Gasman

Enthusiastic Amateur
Local time
Today, 21:37
Joined
Sep 21, 2011
Messages
16,992
Hi all,

I have a several templates in outlook 2003 for my charity work.

All is OK if I send the odd one now and again, but the workload is increasing with more and more at any one time. However having seen various posts on here, I was thinking I could set something similar in Access as well as keeping track of the payments & deposits more easily.

I am fine with to, cc,bcc, body, subject etc, but what I need to do is SendUsingAccount, but 2003 does not have this property, it started with 2007.

As well as sending on that particular account I also need the signature linked to that account.

I could add that signature by code if I can get the correct account and for some reason the signature is not added.

I tried using SendOnBehalfOfName which works as far as the correct email address is used, but still uses my default a/c.

Is there a workaround that I could use in Access/outlook 2003 please.

As an aside, my Outlook session would always be open, so I will use GetObject and not CreateObject method, but would like not to have the warning dialogue in Outlook pop up all the time. is this possible as well please.?

TIA
 
Alright boyo? ;)

Right Gasman, it would be something like this:
Code:
    Set objApp = New Outlook.Application
    Set objNameSpace = objApp.GetNamespace("MAPI")
    Set objFolder = objNameSpace.Folders("[COLOR="Blue"]the account name you want to use[/COLOR]")
    Set objMail = objFolder.Items.Add(olMailItem)
... from then on you can do whatever you wish with objMail and it will send using the account specified.

As for the security warning, since you're the boss and the owner of your network then there's a registry key you can change or depending on your virus program you might be able to change it in Options > Trust Center > Programmatic Access (if it's not disabled). Look it up.
 
Diolch, :D

I am going to need a little more help please.
It fails on

Code:
Set objFolder = objNameSpace.Folders("SSAFA")

In the debugger it shows a count of 2 which are for my pst files that I am using.?
Personal Folders New
Archive Folders

SSAFA account does exist as shown in pic

Error is 438 Object doesn't support this property or method.

So I am thinking I need some other step to get at the account?

TIA

Edit. If it is any easier, I have a command bar of the same name that I use to activate the template. I could use the General entry to open the mail item.?




Alright boyo? ;)

Right Gasman, it would be something like this:
Code:
    Set objApp = New Outlook.Application
    Set objNameSpace = objApp.GetNamespace("MAPI")
    Set objFolder = objNameSpace.Folders("[COLOR="Blue"]the account name you want to use[/COLOR]")
    Set objMail = objFolder.Items.Add(olMailItem)
... from then on you can do whatever you wish with objMail and it will send using the account specified.

As for the security warning, since you're the boss and the owner of your network then there's a registry key you can change or depending on your virus program you might be able to change it in Options > Trust Center > Programmatic Access (if it's not disabled). Look it up.
 

Attachments

  • ssafa.png
    ssafa.png
    72.2 KB · Views: 68
Last edited:
Sounds like you're making progress?

With regards your first error it's most likely the way you declared the object, so for clarity here are all the declarations:
Code:
    Dim objApp          As Outlook.Application
    Dim objNameSpace    As Outlook.Namespace
    Dim objFolder       As Outlook.Folder
    Dim objMail         As Outlook.MailItem
As for the security warning, if the add-in is slowing it down then it's not doing a good job. Look for the registry option or use group policy (if you have that on your Windows installation). You don't need an add-in as it's your private PC.
 
Thanks vbaInet,

I was a little unsure as to the declaration.

I had
Code:
Dim objApp As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objFolder As Outlook.Folders
Dim objMail As Outlook.MailItem

Just changed folder entry to Outlook.Folder, but VBA raises an error 'User-defined type not defined'

I have found a workaround in the meantime by utilising the template I use for general charity message. That uses the correct a/c. I do not get the signature, but I have already worked out that problem. :D

Code:
Set objOutlookMsg = objOutlook.CreateItemFromTemplate(strTemplatePath & "\SSAFA Email.oft")

I've decided to live with the security warning for now, as I will alllow access for the max of 10 minutes, by which time all the emails will be created.

I was even exploring changing the default a/c in the registry and setting it back to normal afterwards, but unable to find code so far that works for 2003.

Even considering getting 2013 as it is frustrating finding 2003 does not do a lot of what I have found on the net.

I have found that
Code:
Set objMail = objFolder.Item(1).Items.Add(olMailItem)

will create the mail item, but again with default a/c. Item(1) is Personal Folders New.
 

Attachments

  • debug.jpg
    debug.jpg
    93.3 KB · Views: 74
Look at your declaration of objFolder.

And let me see your entire code.
 
Sorry, I cannot see it?

For your method I have

Code:
Sub Test3()
Dim objApp As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objFolder As Outlook.Folders
Dim objMail As Outlook.MailItem



    Set objApp = New Outlook.Application
    Set objNameSpace = objApp.GetNamespace("MAPI")
    Set objFolder = objNameSpace.Folders
    Set objMail = objFolder.Items.Add(olMailItem)
    'Set objMail = objFolder.Item(1).Items.Add(olMailItem)
    objMail.Display
    
    
End Sub

and this errors on the Set objMail line.
When declaring folder, there is no option for Folder, only Folders ?

What I have managed to get to work, using the template is

Code:
Sub SendSSAFAMessage(DisplayMsg As Boolean, Optional AttachmentPath)
    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    Dim objOutlookAttach As Outlook.Attachment
    Dim strSigPath As String, strSignature As String, strAttachFile As String
    Dim strHeader As String, strFooter As String, strBody As String, strTemplatePath As String, strAppdata As String
    Dim intBody As Integer
    
    On Error GoTo Err_Handler
    
    ' Get appdata path
    strAppdata = Environ("Appdata")
    
    ' Set paths
    strTemplatePath = strAppdata & "\Microsoft\Templates"
    strSigPath = strAppdata & "\Microsoft\Signatures\Ssafa.htm"
    
    
    'Get the signature if it exists
    If Dir(strSigPath) <> "" Then
        strSignature = GetBoiler(strSigPath)
        intBody = InStr(strSignature, "<BODY>")
        strHeader = Left(strSignature, intBody + 5)
        strFooter = Mid(strSignature, intBody + 6)
    End If

    ' Create the Outlook session.
    Set objOutlook = GetObject(, "Outlook.Application")

    ' Create the message.
    'Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
    Set objOutlookMsg = objOutlook.CreateItemFromTemplate(strTemplatePath & "\SSAFA Email.oft")

    With objOutlookMsg
        ' Add the To recipient(s) to the message.
        Set objOutlookRecip = .Recipients.Add("Jim Needs - SSAFA Swansea")
        objOutlookRecip.Type = olTo

        ' Add the CC recipient(s) to the message.
        Set objOutlookRecip = .Recipients.Add("** SSAFA West Glamorgan Branch")
        objOutlookRecip.Type = olCC

        ' Add the BCC recipient(s) to the message.
        'Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
        'objOutlookRecip.Type = olBCC

        ' Set the Format, Subject, Body, and Importance of the message.
        .BodyFormat = olFormatHTML
        '.SentOnBehalfOfName = "Paul Steel [****@gmail.com]"
        .Subject = "This is an Automation test with Microsoft Outlook"
        .HTMLBody = strHeader & "<BR>" & "This is the body of the message." & "</BR>" & strFooter
        '.HTMLBody = strHeader & "<BR> This is the body of the message." & vbCrLf & vbCrLf & strSignature
        .Importance = olImportanceHigh  'High importance

        ' Add attachments to the message. These will all be in one folder
        If Not IsMissing(AttachmentPath) Then
            strAttachFile = Dir(AttachmentPath & "*.*")
            Do While Len(strAttachFile) > 0
                Set objOutlookAttach = .Attachments.Add(AttachmentPath & strAttachFile)
                strAttachFile = Dir
            Loop
        End If

        ' Resolve each Recipient's name.
        For Each objOutlookRecip In .Recipients
            objOutlookRecip.Resolve
        Next

        ' Should we display the message before sending?
        If DisplayMsg Then
            .Display
        Else
            .Save
            .Send
        End If
    End With
    
Exit_Proc:
    Set objOutlook = Nothing
    Set objOutlookMsg = Nothing
    Set objOutlookRecip = Nothing
    Set objOutlookAttach = Nothing
    
    Exit Sub
    
Err_Handler:
    MsgBox Err.Number & Err.Description
    Resume Exit_Proc
    
End Sub
 
Right here:
Code:
Dim objFolder As Outlook.Folder[COLOR="Red"][B]s[/B][/COLOR]
 
Right here:
Code:
Dim objFolder As Outlook.Folder[COLOR="Red"][B]s[/B][/COLOR]

Yes, I saw that, but as I mentioned if I change it to Folder, it does not compile.

I get the User-defined error I mentioned previously?
If I walk through the assignment with intellisense, there is no Folder option only Folders?
 
There's no Folder object in Outlook 2003? I don't remember anyway.

So let's try one of these:
Code:
Set objMail = objFolder.Item(2).Items.Add(olMailItem)

Set objMail = objFolder.Item("SSAFA").Items.Add(olMailItem)
... with the Folders one that compiles of course.
 
And this should be a 2003 folder declaration:
Code:
Dim objFolder As Outlook.[COLOR="Blue"]MAPIFolder[/COLOR]
 
The first line opened the email, but still on my default a/c.

The second line states 'Object could not be found'.

Attached are my objFolder properties

I've just seen your last post

I now get Type mismatch on the last line
Code:
Sub Test3()
Dim objApp As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objMail As Outlook.MailItem




    Set objApp = New Outlook.Application
    Set objNameSpace = objApp.GetNamespace("MAPI")
    Set objFolder = objNameSpace.Folders

There's no Folder object in Outlook 2003? I don't remember anyway.

So let's try one of these:
Code:
Set objMail = objFolder.Item(2).Items.Add(olMailItem)

Set objMail = objFolder.Item("SSAFA").Items.Add(olMailItem)
... with the Folders one that compiles of course.
 

Attachments

  • debug1.jpg
    debug1.jpg
    95.9 KB · Views: 75
I now get Type mismatch on the last line
Code:
    Set objFolder = objNameSpace.Folders
MAPIFolder is a folder object and expects a folder object. You're returning a Folders collection. But this is just buy the way.

If an item is created using a specific account it should use that account to send the item. Try saving the item after adding it and fetch it from that specific account.
 
VbaInet,

I am more than happy to go with the template route, rather than waste any more of your valuable time.

I think Outlook 2003 is missing a lot of the features everyone else has got used to. :)

I can do what I was looking to do just as easy with the template.

Many thanks for your help, especially on the weekend. :D
 
Don't worry, I'm on the balcony having a glass of red at the moment so you're not taking up much of my time ;)

It's hard when you don't have that particular version to work with. I'll post some suggestions later.
 
Ok, I know how you feel. :D

Enjoy the wine.

Thank you.
 
Isn't that what the template is doing?

If an item is created using a specific account it should use that account to send the item. Try saving the item after adding it and fetch it from that specific account.
 
Template is a workaround and it means that each user must have that template for it to work. I don't think work towards workarounds until I've exhausted all possible options. There are other workarounds, i.e. using CDO, using Redemption and with these you don't get the security message.

With that said, run the following code:
Code:
Public Sub SendUsingAnAccount()
    Dim otApp        As Outlook.Application
    Dim otNamespace  As Outlook.Namespace
    Dim otMail       As Outlook.MailItem
    Dim strSender    As String
    
    Set otApp = GetObject(, "Outlook.Application")
    Set otNamespace = otApp.Session
    
    ' Create mail item in the specified account
    With otNamespace
        strSender = .Accounts("SSAFA").SmtpAddress
        Set otMail = .Folders(strSender).Items.Add(olMailItem)
    End With
    
    ' Compose and send mail
    With otMail
        .To = "[COLOR="Blue"]gasman@swansea.co.uk[/COLOR]"
        .SentOnBehalfOfName = strSender
        .Subject = "test"
        .Body = "test"
        .Send
    End With
    
    Set otApp = Nothing
End Sub
... SentOnBehalfOfName is not necessary but I've just put it there for completeness. If the above works, remove it and it should still run.
 

Users who are viewing this thread

Back
Top Bottom