View Full Version : [SOLVED:] Composing Email using Macro
inderdaad
10-24-2017, 02:11 AM
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
10-24-2017, 02:35 AM
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
10-24-2017, 03:03 AM
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
10-24-2017, 03:13 AM
You can use the cell names for the email & subject if the range doesn't change
"Quote - " & Sheets("Summary").Range("CQuoteNumber") & "<br>" &
inderdaad
10-24-2017, 04:48 AM
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
10-24-2017, 05:13 AM
Yes, this is just 1 email address which is found using a v lookup and the value returned to that cell.
greyangel
10-24-2017, 05:53 AM
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.