VB6 and MSOutlook 2007 - Send Email

I've noted I can achieve what I want through CDOSYS

<%
Set myMail=CreateObject("CDO.Message")
myMail.Subject="Sending email with CDO"
myMail.From="mymail@mydomain.com"   <<========= setting where the email is coming from
myMail.To="someone@somedomain.com"
myMail.TextBody="This is a message."
myMail.Send
set myMail=nothing
%>

Select allOpen in new window

Can I do this from VB6 and Outlook?

ok - heres what I have worked out.

I've adapted the concept of selecting an account to send from using the following code:

Private Function DoMailMerge(ContactLink As Long)

Dim objOutlook As Outlook.Application
Dim objMailItem As Outlook.MailItem

Set objOutlook = CreateObject("Outlook.Application")
Set objMailItem = objOutlook.CreateItem(0) 'The constant olMailItem = 0

Dim strBody$
Dim strSender$
 
strSender = cboSender.Text
If Trim(strSender) = "" Then
    MsgBox "You forgot to select the sender.", vbExclamation
    Exit Function
End If

    strBody = "Your Reference : " & Trim(txt(24).Text) & "<br>"
    strBody = strBody & "Our Reference : " & "<br>" & "<br>"
    strBody = strBody & Trim(txt(23).Text) & "<br>" & "<br>"
    strBody = strBody & "<b>RE:</B> " & Replace(Trim(txt(22).Text), vbCrLf, " - ", 1)
    strBody = strBody & "" & "<br>" & "<br>"
    strBody = strBody & "<i>[start typing here]</i>" & "<br>" & "<br>"

    With objMailItem
        '.SenderEmailAddress = strSender
        .To = Trim(txt(6).Text)
        .CC = ""
        .BCC = ""
        .SendUsingAccount = GetAccountForEmailAddress(objOutlook, strSender)
        .Importance = olImportanceHigh
        .ReadReceiptRequested = True
        '.Attachments.Add strAttachment
        .Subject = Replace(Trim(txt(22).Text), vbCrLf, " - ", 1)
        .BodyFormat = olFormatHTML
        .HTMLBody = strBody
        
        
        .Display
    End With
    Set objOutlook = Nothing
    Set objMailItem = Nothing

End Function

Function GetAccountForEmailAddress(ByVal objOutlook As Outlook.Application, ByVal smtpAddress As String) As Outlook.account
    ' Loop over the Accounts collection of the current Outlook session.
    Dim accounts As Outlook.accounts
    Set accounts = objOutlook.Session.accounts
    Dim account As Outlook.account
    For Each account In accounts
    

        ' When the e-mail address matches, return the account.
        If account.smtpAddress = smtpAddress Then
            Set GetAccountForEmailAddress = account
            Exit Function
        End If
    Next
    'if we ge here we did not find the account for the email address entered
    MsgBox "Email Account " & smtpAddress & " Not found"

End Function

Select allOpen in new window

You can see I've added a function GetAccountForEmailAddress which returns the account from which the email is to be sent from.

Now I've also worked out that if I do not fill in the body of the message, outlook inserts the correct default signature - but if I put some text into the body of the email the default signature is not inserted and I think that might be by default.

So how do I ensure that the signature is inserted no matter what text I put into the body?

DWE

dont think you can because the Signature is just html that is added by outlook when you start a message.

you could try setting the SendAccount as the last item , after setting the bodytext to see if that adds to the end of the bodytext.

Theres a chance you might be right ... but ... funnily enough in Outlook 2007, the signatures are seemingly managed by Word ... given that word is the only available editor ...

the following function enumerates all of the Signatures - pass a valid message or take the reference out (it does nothing for the moment) - I was going to try to enumerate other objects off it but haven't done so yet ... given that we can get the index of the signature and given that we can get the signature name and so forth - it would be somewhat amazing of there is no way of getting the actual signature block itself - particularly since one can be created on the fly ...

Function EnumEmailSigs(msg As Outlook.MailItem)

    Dim objDoc               As Word.Document
    Dim objSel               As Word.Selection
    Dim objSig               As Word.EmailSignature
    Dim colSig               As Word.EmailSignatureEntries

    Set objDoc = msg.GetInspector.WordEditor
    Set objSig = objDoc.Application.EmailOptions.EmailSignature
    Set colSig = objSig.EmailSignatureEntries

    Dim i%

    Debug.Print colSig.Count & " Signatures Present"

    'With msg
    '    .Actions


    For i = 1 To colSig.Count '- 1

        Debug.Print i & " - "; colSig.Item(i).Name      ' name of signature
        'Debug.Print i & " - "; colSig.Item(i).Creator   '
        'Debug.Print i & " - "; colSig.Item(i).Index    '

    Next i

    Debug.Print "NewMessage - " & objSig.NewMessageSignature

End Function

its not just word... we set our signatures via a GPO Exchange setting i believe. or at least create defaults that way.

seems a lot just to get a signature to insert. While the sig is just a text file in the users profile directory, i cant find any way to get the association between an account and the signature to use for new message and replies.  (it is possible to have more than one signature tied to an account, and then set which one is to be used for different types of messages)

so if it works, stick with it.

yes it probably does seem a lot but once the coding is done its fairly simple - the next stage is working with the wordeditor to create the proper merge files .. for example, all word features are available ... including importing word documents with all the merge information in it ... but that will be another issue no doubt in the future ...

MTIA

DWE

I solved my own issue - and would prefer to leave this solution open for others to find ..