Hello everyone! I'm new VBA and also to the Forums -although I've been gleaning bits and pieces of information as a visitor for a while. I need to automate some tasks in Excel/Outlook where I am currently manually selecting data in Excel and coping/pasting to an email to be sent. I found some common code online that will do some of what I need and I've been able to tweak it a bit for more functionality. However, I'm struggling on a couple of the statements and just cannot figure out how to correctly state it.
Overview:
• From within Excel worksheet, will open a new email based on an existing Outlook template.
• Data from Columns F - K to be copied and pasted into the body of the email.
• Column X contains the text for the Subject field in the email.
• Column N contains the email addresses for the To Field in the email.
• Because the data copied/pasted into each email will vary by the number of rows (sometimes I will select F2:K2, sometimes F2:K5, etc.), I need to manually select a range then run the macro.
Essentially, here’s what I need the macro to do:
STEP 1: Open an existing email template in Outlook
STEP 2: Copy the range I've selected and paste it into the body of the email.
STEP 3: Look at the range that I've selected and copy the email address from column N of the first row in the range and paste it into the To field of the email. (i.e., if I selected range F34:K38, the email is to be sent to the address in cell N34)
STEP 4: Look at the range that I've selected and copy the text from column X of the first row in the range and paste it into the Subject field of the email. (i.e., if I selected range F34:K38, the subject of the email is in cell X34)
So far, my code will do steps 1 & 2, but I’m stuck on getting it to do 3 & 4 because I don’t know how to tell it to look at only one cell in the workbook that is corresponding to the selected range.
I’m thinking the code needs to be something with .Offset but I’m not sure how to incorporate that properly. I’ve marked in the code below where I’m having problems and get errors. Any help and/or direction would be greatly appreciated.
Sub SendSelectedCells_inOutlookEmail()
Dim objSelection As Excel.Range
Dim objTempWorkbook As Excel.Workbook
Dim objTempWorksheet As Excel.Worksheet
Dim strTempHTMLFile As String
Dim objTempHTMLFile As Object
Dim objFileSystem As Object
Dim objTextStream As Object
Dim objOutlookApp As Outlook.Application
Dim objNewEmail As Outlook.MailItem
'Dim template As String
'Copy the selection
Set objSelection = Selection
Selection.Copy
'Paste the copied selected ranges into a temp worksheet
Set objTempWorkbook = Excel.Application.Workbooks.Add(1)
Set objTempWorksheet = objTempWorkbook.Sheets(1)
'Keep the values, column widths and formats in pasting
With objTempWorksheet.Cells(1)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteFormats
End With
'Save the temp worksheet as a HTML file
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
strTempHTMLFile = objFileSystem.GetSpecialFolder(2).Path & "\Temp for Excel" & Format(Now, "YYYY-MM-DD hh-mm-ss") & ".htm"
Set objTempHTMLFile = objTempWorkbook.PublishObjects.Add(xlSourceRange, strTempHTMLFile, objTempWorksheet.Name, objTempWorksheet.UsedRange.Address)
objTempHTMLFile.Publish (True)
'Create a new email
Set objOutlookApp = CreateObject("Outlook.Application")
'Set objNewEmail = objOutlookApp.CreateItem(olMailItem)
'Set olMail = olApp.CreateItem(olMailItem)
'Set olMail = CreateItemFromTemplate("C:\Users\blucajun\AppData\Roaming\Microsoft\Templates\NEW LR Request.oft")
Set objNewEmail = objOutlookApp.CreateItemFromTemplate("C:\Users\blucajun\AppData\Roaming\Microsoft\Templates\NEW LR Request.oft")
'Read the HTML file data and insert into the email body
Set objTextStream = objFileSystem.OpenTextFile(strTempHTMLFile)
objNewEmail.HTMLBody = objTextStream.ReadAll
'You can specify the new email recipients, subjects here using the following lines:
'objNewEmail.To = "janedoe@anyemail.com"
'objNewEmail.Subject = "ABC Company Info."
'objNewEmail.Send --> directly send out this email
objNewEmail.To = ActiveSheet.Range("N" & each_row).Text [this is where it ERRs]
objNewEmail.Subject = ActiveSheet.Range("X" & each_row).Text
objNewEmail.Display
objTextStream.Close
objTempWorkbook.Close (False)
objFileSystem.DeleteFile (strTempHTMLFile)
End Sub
Overview:
• From within Excel worksheet, will open a new email based on an existing Outlook template.
• Data from Columns F - K to be copied and pasted into the body of the email.
• Column X contains the text for the Subject field in the email.
• Column N contains the email addresses for the To Field in the email.
• Because the data copied/pasted into each email will vary by the number of rows (sometimes I will select F2:K2, sometimes F2:K5, etc.), I need to manually select a range then run the macro.
Essentially, here’s what I need the macro to do:
STEP 1: Open an existing email template in Outlook
STEP 2: Copy the range I've selected and paste it into the body of the email.
STEP 3: Look at the range that I've selected and copy the email address from column N of the first row in the range and paste it into the To field of the email. (i.e., if I selected range F34:K38, the email is to be sent to the address in cell N34)
STEP 4: Look at the range that I've selected and copy the text from column X of the first row in the range and paste it into the Subject field of the email. (i.e., if I selected range F34:K38, the subject of the email is in cell X34)
So far, my code will do steps 1 & 2, but I’m stuck on getting it to do 3 & 4 because I don’t know how to tell it to look at only one cell in the workbook that is corresponding to the selected range.
I’m thinking the code needs to be something with .Offset but I’m not sure how to incorporate that properly. I’ve marked in the code below where I’m having problems and get errors. Any help and/or direction would be greatly appreciated.
Sub SendSelectedCells_inOutlookEmail()
Dim objSelection As Excel.Range
Dim objTempWorkbook As Excel.Workbook
Dim objTempWorksheet As Excel.Worksheet
Dim strTempHTMLFile As String
Dim objTempHTMLFile As Object
Dim objFileSystem As Object
Dim objTextStream As Object
Dim objOutlookApp As Outlook.Application
Dim objNewEmail As Outlook.MailItem
'Dim template As String
'Copy the selection
Set objSelection = Selection
Selection.Copy
'Paste the copied selected ranges into a temp worksheet
Set objTempWorkbook = Excel.Application.Workbooks.Add(1)
Set objTempWorksheet = objTempWorkbook.Sheets(1)
'Keep the values, column widths and formats in pasting
With objTempWorksheet.Cells(1)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteFormats
End With
'Save the temp worksheet as a HTML file
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
strTempHTMLFile = objFileSystem.GetSpecialFolder(2).Path & "\Temp for Excel" & Format(Now, "YYYY-MM-DD hh-mm-ss") & ".htm"
Set objTempHTMLFile = objTempWorkbook.PublishObjects.Add(xlSourceRange, strTempHTMLFile, objTempWorksheet.Name, objTempWorksheet.UsedRange.Address)
objTempHTMLFile.Publish (True)
'Create a new email
Set objOutlookApp = CreateObject("Outlook.Application")
'Set objNewEmail = objOutlookApp.CreateItem(olMailItem)
'Set olMail = olApp.CreateItem(olMailItem)
'Set olMail = CreateItemFromTemplate("C:\Users\blucajun\AppData\Roaming\Microsoft\Templates\NEW LR Request.oft")
Set objNewEmail = objOutlookApp.CreateItemFromTemplate("C:\Users\blucajun\AppData\Roaming\Microsoft\Templates\NEW LR Request.oft")
'Read the HTML file data and insert into the email body
Set objTextStream = objFileSystem.OpenTextFile(strTempHTMLFile)
objNewEmail.HTMLBody = objTextStream.ReadAll
'You can specify the new email recipients, subjects here using the following lines:
'objNewEmail.To = "janedoe@anyemail.com"
'objNewEmail.Subject = "ABC Company Info."
'objNewEmail.Send --> directly send out this email
objNewEmail.To = ActiveSheet.Range("N" & each_row).Text [this is where it ERRs]
objNewEmail.Subject = ActiveSheet.Range("X" & each_row).Text
objNewEmail.Display
objTextStream.Close
objTempWorkbook.Close (False)
objFileSystem.DeleteFile (strTempHTMLFile)
End Sub
