Composing Email using Macro

[inderdaad]

Hello,

the code below puts some excel data on the clipboard and generates an Email message
The address and subject are filled in (generated by Hyperlink)
Today I manually paste the clipboard's content into the body of the Email, works fine
Could this be done using VBA



Range("N4:U38").Select
Selection.Copy
Dim FindString As String
Dim rng As Range
FindString = Sheets("Externe bestelling").Range("O3").Value
If Trim(FindString) <> "" Then
With Sheets("Externe bestelling").Range("N:N")
Set rng = .Find(What:=FindString)

If Not rng Is Nothing Then
Application.Goto rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
Selection.Hyperlinks(1).Follow NewWindow:=True, AddHistory:=True


Hope someone could help me

Thanks in advance

[nathandavies]

Have a look at this code. this creates an email using a macro.


Function GetBoiler(ByVal sFile As String) As String Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.ReadAll
ts.Close
End Function


Sub HTMLHandoverForm()
'This should work in Office 2000-2010


Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

'Set the wording of the email
strbody = "<FONT color=#000000 face=Calibri size=3>" & _
"- This is handover form has been raised manually for the contract referenced below because sales requested the need for a handover and you quoted this contract <br>" & _
"- By replying to this email you are confirming that a handover took place <br>" & _
"- During the handover meeting if you uncover topics/actions <u>THAT ARE NOT ALREADY</u> on the work instruction, then summarise in your reply. Otherwise leave your reply blank. <br> <br> <br>" & _
"Quote - " & Sheets("Summary").Range("CQuoteNumber") & "<br>" & _
"Job Number - " & Sheets("Summary").Range("CJobNumber") & "-" & Sheets("Summary").Range("CJobNumberSub") & "<br>" & _
"Company - " & Sheets("Summary").Range("CCompanyName") & "<br>" & _
"Site - " & Sheets("Summary").Range("CSiteName") & "<br>" & _
"Description - " & Sheets("Summary").Range("CDescription")




'Set the subject of the email
If Sheets("Summary").Range("CQuoteNumber") = "" Then
strsubject = "HANDOVER FORM. " & Sheets("Summary").Range("CCompanyName") & ". Job " & Sheets("Summary").Range("CJobNumber") & "-" & Sheets("Summary").Range("CJobNumberSub")
Else
strsubject = "HANDOVER FORM. " & Sheets("Summary").Range("CCompanyName") & ". Job " & Sheets("Summary").Range("CJobNumber") & "-" & Sheets("Summary").Range("CJobNumberSub") & " and Quote " & Sheets("Summary").Range("CQuoteNumber")
End If

'Specify where the signature file is
SigString = Environ("appdata") & "\Microsoft\Signatures\excelsignature.htm"
'This uses the GetBoiler code above
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
'If there is no signature file then the email will have no signature
Else
Signature = ""
End If


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = Sheets("Summary").Range("CQEEmail")
.Subject = strsubject
.HTMLBody = strbody
.Attachments.Add ActiveWorkbook.FullName
.Display 'or use .Send
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing

ActiveWorkbook.Save

End Sub

[inderdaad]

Hi,

indeed your code creates an email but from the looks of it there is predefined text and subject in it
I think it is not helping in my case

Thanks anyway

[nathandavies]

You can use the cell names for the email & subject if the range doesn't change


"Quote - " & Sheets("Summary").Range("CQuoteNumber") & "<br>" &

[inderdaad]

Commng back to your code there is a line wich is interesting

.To = Sheets("Summary").Range("CQEEmail")

Does this refer to one email adres or to list of adresses
Actually I am looking for a variable here

Some advise?

[nathandavies]

Yes, this is just 1 email address which is found using a v lookup and the value returned to that cell.

[greyangel]

I use this macro all the time for mass e-mailing. It is kind of self explanatory. You can put as many recipients as you want and they each get a customized file or you can just remove the customized file by deleting the .attachment.add line.


Sub Sed_Email()
'Created by Robbie DePalma
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Range("B2").Select

Body_text = Range("H2").Value


Do Until ActiveCell.Offset(-1).Value = ""
recipipent = ActiveCell.Value
Sending_file = ActiveCell.Offset(, 1).Value

'Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Dim iFile As Integer
Dim strVar As String


iFile = FreeFile

Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = recipipent
.Subject = Range("G2").Value
.Body = Body_text ' here will be the body of first value
.Display 'Or use Display
.Attachments.Add (Sending_file)
.send
End With
On Error GoTo 0
Set OutMail = Nothing
With ActiveCell.Offset(, 2)
.Value = Date
.NumberFormat = "mm/dd/yy"
End With
ActiveCell.Offset(1).Select
Loop






End Sub