Paste Image to Body of Email

[Johndinho]

Hi,

I am trying to paste an image to the body of an email and getting a strange error

Sub SendEmail()

Dim oWSHShell As Object
Set oWSHShell = CreateObject("WScript.Shell")
Dim Msg As Object
Dim Conf As Object
Dim msgBody As String
Dim ConfFields As Variant
Dim wb As Workbook

With Application
.EnableEvents = False
End With

Set wb = ActiveWorkbook
Set Msg = CreateObject("CDO.Message")
Set Conf = CreateObject("CDO.Configuration")

Conf.Load -1    ' CDO Source Defaults
Set ConfFields = Conf.Fields
    With ConfFields
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    'Enter the username and password of your email account below
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "me@gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
    'Edit the SMTP server below e.g. smtp.gmail.com or smtp.mail.yahoo.co.uk
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
    .Update
End With
With Msg
    Set .Configuration = Conf
    'Add the email address to whom to send the email below
    .To = "me@gmail.com"
    .CC = ""
    .BCC = ""
    .From = "someone@gmail"
    .Subject = "Image"
    .HTMLBody = "< img src='oWSHShell.SpecialFolders("Desktop") & "\DieBond.png"'>"     (Without the space between "<" and "img")
    .Send
End With

End Sub

I have to use SpecialFolders because different users have their desktops in different places (Thanks to our Dropbox installer: c:\users\username\desktop or c:\desktop)

I can export the files to the desktop no problem but everytime I try to run the code I get;

Compile Error:
Expected: end of statement

And the .HTMLBody line is highlighted.

I use this code elsewhere and the "Call .AddAttchment" function but for this project; I want the image in the body of the email

Any suggestions would be gratefully received.

In your debt as always

 

[lrobbo314]

Try this

Sub SendEmail()


Dim oWSHShell As Object
Set oWSHShell = CreateObject("WScript.Shell")
Dim Msg As Object
Dim Conf As Object
Dim msgBody As String
Dim ConfFields As Variant
Dim wb As Workbook
Dim Path As String


With Application
.EnableEvents = False
End With


Set wb = ActiveWorkbook
Set Msg = CreateObject("CDO.Message")
Set Conf = CreateObject("CDO.Configuration")
Path = oWSHShell.SpecialFolders("Desktop")


Conf.Load -1    ' CDO Source Defaults
Set ConfFields = Conf.Fields
    With ConfFields
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    'Enter the username and password of your email account below
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "me@gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
    'Edit the SMTP server below e.g. smtp.gmail.com or smtp.mail.yahoo.co.uk
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
    .Update
End With
With Msg
    Set .Configuration = Conf
    .attachments.Add Path & "\" & "DieBond.png", olbyvalue, 0
    'Add the email address to whom to send the email below
    .To = "me@gmail.com"
    .CC = ""
    .BCC = ""
    .From = "someone@gmail"
    .Subject = "Image"
    .HTMLBody = "< img src='cid:DieBond.png'>" 'Remove space
    .Send
End With


End Sub

 

[Johndinho]

Thanks but I got a different error;

Run-time error '450';
Wring number of arguments or invalid property assignment

And it debugs to

.attachments.Add Path & "" & "DieBond.png", olbyvalue, 0

 

[lrobbo314]

Try

.attachments.Add Path & "" & "DieBond.png", Empty, 0

 

[lrobbo314]

When I post it is getting rid of the \ character in between the "".

Make sure to put the \ after the 'Path' variable

 

[Johndinho]

Got it!! this should be the last part of your code

With Msg
    Set .Configuration = Conf
    Call .Addattachment(oWSHShell.SpecialFolders("Desktop") & "\" & "Image.png")
    'Add the email address to whom to send the email below
    .To = "me@gmail.nl"
    .CC = ""
    .BCC = ""
    .From = "someone@gmail.com"
    .Subject = "Image"
    .HTMLBody = "< img src='cid:Image.png'>" 'Remove space
    .Send
End With

Thanks Robbo

 

[Johndinho]

Not sureif your other suggestions will work; I'm going to try adding more than one image now so I may be back!

Thanks again

 

[lrobbo314]

Cool. Glad you got it worked out.

───────────────────░█▓▓▓█░▇▆▅▄▃▂
──────────────────░█▓▓▓▓▓█░▇▆▅▄▃▂
─────────────────░█▓▓▓▓▓█░▇▆▅▄▃▂
──────────░░░───░█▓▓▓▓▓▓█░▇▆▅▄▃▂ ...
─────────░███░──░█▓▓▓▓▓█░▇▆▅▄▃▂
───────░██░░░██░█▓▓▓▓▓█░▇▆▅▄▃▂
──────░█░░█░░░░██▓▓▓▓▓█░▇▆▅▄▃▂
────░██░░█░░░░░░█▓▓▓▓█░▇▆▅▄▃▂
───░█░░░█░░░░░░░██▓▓▓█░▇▆▅▄▃▂
──░█░░░░█░░░░░░░░█▓▓▓█░▇▆▅▄▃▂
──░█░░░░░█░░░░░░░░█▓▓▓█░▇▆▅▄▃▂
──░█░░█░░░█░░░░░░░░█▓▓█░▇▆▅▄▃▂
─░█░░░█░░░░██░░░░░░█▓▓█░▇▆▅▄▃▂
─░█░░░░█░░░░░██░░░█▓▓▓█░▇▆▅▄▃▂
─░█░█░░░█░░░░░░███▓▓▓▓█░▇▆▅▄▃▂
░█░░░█░░░██░░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
░█░░░░█░░░░█████▓▓▓▓▓█░▇▆▅▄▃▂
░█░░░░░█░░░░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
░█░█░░░░██░░░░█▓▓▓▓▓█░▇▆▅▄▃▂
─░█░█░░░░░████▓▓▓▓██░▇▆▅▄▃▂
─░█░░█░░░░░░░█▓▓██▓█░▇▆▅▄▃▂
──░█░░██░░░██▓▓█▓▓▓█░▇▆▅▄▃▂
───░██░░███▓▓██▓█▓▓█░▇▆▅▄▃▂
────░██▓▓▓███▓▓▓█▓▓▓█░▇▆▅▄▃▂
──────░█▓▓▓▓▓▓▓▓█▓▓▓█░▇▆▅▄▃▂
──────░█▓▓▓▓▓▓▓▓▓▓▓▓▓█░▇▆▅▄▃▂

 

[Johndinho]

Love that