I'm trying to get all the cells from my Excel worksheet in column 1.
My code throws an error.
"object required"
Public Sub emailList()
'Setting up the Excel variables.
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String
'Create the Outlook application and the empty email.
Set olApp = CreateObject("Outlook.Application")
Set olMailItm = olApp.CreateItem(0)
'Using the email, add multiple recipients, using a list of addresses in column A.
With olMailItm
SDest = ""
For iCounter = 1 To WorksheetFunction.CountA(Workbooks("Book1.xls").Sheets(1).Columns(1))
If SDest = "" Then
SDest = Range.Cells(iCounter, 1).Value
Else
SDest = SDest & ";" & Range.Cells(iCounter, 1).Value
End If
Next iCounter
'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
.BCC = SDest
.Subject = "FYI"
.Body = ActiveSheet.TextBoxes(1).Text
.Send
End With
'Clean up the Outlook application.
Set olMailItm = Nothing
Set olApp = Nothing
End Sub
How do I get a worksheet object?
I tried
Workbooks("Book1.xls").Sheet1.Columns(1)
but this also throws an error.
I'm running the code in Outlook and have an open Excel window.
You will need to add a reference to the Excel object library, which is done in the VBA editor, under Tools / Add References. Just having Excel open isn't enough.
Related
I'm really having trouble finding any answers for this problem. I have an Excel macro that filters a sheet (it's a basic order form), copies and emails a range using an Outlook object. The file worked for several weeks and ran quickly.
Now all of the sudden whenever the macro is run the Excel portion of filtering and copying works fine but when it gets to the email code Outlook locks up, and I get a popup from Excel saying it's waiting for Outlook to complete an OLE action. I end up having to kill the Outlook process. I've tried early and late bindings.
Sub EmailOrder()
Dim answer As Integer
Dim lastRow As String
Dim filteredRow
Dim emailApp As Outlook.Application
Dim emailItem As Outlook.MailItem
Dim exportRange As Range
Dim currentTime As String
Dim currentUserEmailAddress As String
answer = MsgBox("Click OK to send your order to the supply team", vbOKCancel)
If answer = vbOK Then
Worksheets("Sheet1").Activate
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
currentTable = "$A$1:$E$" & lastRow
'Filter out blanks
Range(currentTable).AutoFilter Field:=5, Criteria1:="<>"
Set exportRange = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set exportRange = Selection.SpecialCells(xlCellTypeVisible)
'Setup outlook objects and mail
Set emailApp = New Outlook.Application
Set emailItem = emailApp.CreateItem(olMailItem)
Set outSession = emailItem.Session.CurrentUser
currentUserEmailAddress = outSession.AddressEntry.GetExchangeUser().PrimarySmtpAddress
currentTime = Now
'Write email
With emailItem
.To = "redacted#gmail.com"
.CC = currentUserEmailAddress
.Subject = "Local Inventory Order " & currentTime
.HTMLBody = RangetoHTML(exportRange)
.Send
End With
'Close objects
Set emailApp = Nothing
Set emailItem = Nothing
MsgBox ("The order has been emailed to the supply team.")
End If
End Sub
The RangetoHTML function is from Ron de Bruin's website. Any help is appreciated.
EDIT: failed to mention that there have been other users of the sheet who reported it working for several weeks then stopping.
I have a excel sheet with personal information such as name, email address etc. and I also have a VBA code that when a cell in a specific range is selected (range R in this case) then call the VBA macro to send a mail.
But how do I assign the email address of the specific person to my VBA code?
For example:
if I click on cell R5, then the VBA macro should start running to send a mail to the email address in cell M5 and cell O5 or if I click on cell R10, then it should email to the email address in cell M10 and cell O10.
See below the code I have so far:
When I click on any cell in range R, the following VBA macro is triggered
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("R6:R1000000")) Is Nothing Then
Call Send_Email
End If
End If
End Sub
The macro Send_Email:
Sub Send_Email()
Dim EmailApp As Outlook.Application
Dim NewEmailItem As Outlook.MailItem
Dim Scr As String
Set EmailApp = New Outlook.Application
Set NewEmailItem = EmailApp.CreateItem(olMailItem)
NewEmailItem.To = ****** here should be the cell reference ******
'NewEmailItem.CC = ****** here should be the cell reference ******
NewEmailItem.Subject = "abcd"
With NewEmailItem
.HTMLBody = "Hello abcd" etc.
End With
End Sub
Here is the sample code which does exactly the same - shows how to send an email to a list of recipients based on data stored in a workbook. The recipient email addresses must be in column A, and the body text of the email must be in the first text box on the active sheet:
Sub Sample()
'Setting up the Excel variables.
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String
'Create the Outlook application and the empty email.
Set olApp = CreateObject("Outlook.Application")
Set olMailItm = olApp.CreateItem(0)
'Using the email, add multiple recipients, using a list of addresses in column A.
With olMailItm
SDest = ""
For iCounter = 1 To WorksheetFunction.CountA(Columns(1))
If SDest = "" Then
SDest = Cells(iCounter, 1).Value
Else
SDest = SDest & ";" & Cells(iCounter, 1).Value
End If
Next iCounter
'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
.BCC = SDest
.Subject = "FYI"
.Body = ActiveSheet.TextBoxes(1).Text
.Send
End With
'Clean up the Outlook application.
Set olMailItm = Nothing
Set olApp = Nothing
End Sub
In your scenario with a separate function for sending emails you can pass the required data via parameters.
I want to copy data from multiple ranges in an Excel sheet to an email body.
Below is the code I have come up with.
How to make ranges paste one under the other and how to add text after ranges but before signature from Outlook.
How it is now:
Sub reportCostLunch()
Dim recipient(0) As Variant
recipient(0) = ""
Dim outlook As Object
Dim email As Object
Dim xInspect As Object
Dim pageEditor As Object
Dim lastRow As Long
Dim sheet, sheet1 As Worksheet
Dim SDest As String, title As String, slot As String
Set sheet = ThisWorkbook.Sheets("SHEET1")
Set sheet1 = ThisWorkbook.Sheets("SHEET2")
title = sheet.Range("D13").Value
Set outlook = CreateObject("Outlook.Application")
Set email = outlook.CreateItem(0)
With email
SDest = ""
For i = LBound(recipient) To UBound(recipient)
If SDest = "" Then
SDest = recipient(i)
Else
SDest = SDest & ";" & recipient(i)
End If
Next i
.To = SDest
.Subject = title
.Display
Set xInspect = email.GetInspector
Set pageEditor = xInspect.WordEditor
Worksheets("SHEET2").Range("C44:AF71").Copy
pageEditor.Application.Selection.start = 1
pageEditor.Application.Selection.End = pageEditor.Application.Selection.start
pageEditor.Application.Selection.PasteAndFormat (wdChartPicture)
pageEditor.Application.Selection.InsertParagraphAfter
Worksheets("SHEET2").Range("C26:AF44").Copy
pageEditor.Application.Selection.PasteAndFormat (wdChartPicture)
pageEditor.Application.Selection.InsertParagraphAfter
.Display
email.HTMLBody = "SOME TEXT " _
& email.HTMLBody & " some text"
Set pageEditor = Nothing
Set xInspect = Nothing
End With
Set email = Nothing
Set outlook = Nothing
Application.CutCopyMode = False
End Sub
Create the Email Body in VBA.
Put it together into one variable, including all your paragraphs and line breaks. Then use that one variable for
email.HTMLBody = varEmailBody
Edit: If you use .HTMLBody you can't copy/paste anything. You need to construct the HTML as text somewhere (in your code). Ron de Bruin has excellent examples of all kinds of Excel to Outlook email scenarios. Here is one for mailing an Excel range in an HTML body: https://www.rondebruin.nl/win/s1/outlook/bmail2.htm -- You may need to construct one contiguous range in your worksheet (maybe on a hidden sheet) that you can process in the VBA as one range.
I'm trying to open an Outlook template (.oft) file from Excel but without appending the user's signature. I can't get this to work.
I know I need to delete the hidden bookmark "_MailAutoSig" but I can't figure out how. I've tried to follow this guide but it's out of date and doesn't work with Outlook / Excel 2016: https://learn.microsoft.com/en-us/previous-versions/office/developer/office-2007/dd492012(v=office.12)#176-working-with-outlook-signatures
Here is my code
Option Explicit
Sub openEmail()
Dim cfgFromEmail As String
Dim cfgNotice As String
Dim cfgTemplate As String
Dim appOutlook As Outlook.Application
Dim newEmail As Outlook.MailItem
Dim rownum As Integer
Dim colnum As Integer
rownum = 6
cfgFromEmail = Sheets("Email").Range("O5").Value
cfgNotice = Sheets("Email").Cells(rownum, 10) '10 = column J
cfgTemplate = Sheets("Email").Cells(rownum, 11) '11 = column K
Set appOutlook = CreateObject("Outlook.Application")
Set newEmail = appOutlook.CreateItemFromTemplate("\\location\to\template\" & cfgTemplate & ".oft")
'Set template = mailApp.CreateItem(olMailItem) 'Creates a blank email
If cfgNotice <> "null" Then 'If is not blank
MsgBox cfgNotice, vbInformation, "Before you send the email"
End If
With newEmail
.SentOnBehalfOfName = cfgFromEmail
.Display 'Show the email
End With
Set newEmail = Nothing
Set appOutlook = Nothing
End Sub
Any help is greatly appreciated. I have spent several hours searching Google and Stack Overflow to no luck.
If the email template is not too complicated, you may be able to just create a new email and create the template without signature using HTML:
Sub emailgenerator
Dim appOutlook As Outlook.Application
Dim newEmail As Outlook.MailItem
Dim emailBody As String
Set appOutlook = CreateObject("Outlook.Application")
Set newEmail = olApp.CreateItem(olMailItem)
emailBody = "<p>Header</p><br><p>body area or something</p>"
emailBody = emailBody & "<table></table>" ' maybe add tables and whatever is needed
With newEmail
.To = "abc#abc.com"
.CC = "def#def.com"
.Subject = "Test"
.SentOnBehalfOfName = "youremail#youremail.com" ' could disregard this
.HTMLBody = emailBody
.Save
.Close olPromptForSave
End With
End Sub
This will take some looking into HTML but you can probably recreate the template with enough effort.
I believe when I tried this method for another project my signature wasn't getting appended automatically as it would with a template but not sure... best of luck
I have found a solution thanks to this stack overflow post
We need to save our template as HTML, then manually create a new email using the HTML code.
I'm yet to add images to the code but I think this will be easy using a find and replace method.
Final code without images:
Option Explicit
Sub openEmail(rownum As Integer)
Dim cfgFromEmail As String
Dim cfgNotice As String
Dim cfgTemplate As String
Dim appOutlook As Outlook.Application
Dim newEmail As Outlook.MailItem
Dim htmlPath As String
'Dim rownum As Integer
'Dim colnum As Integer
'rownum = 6
cfgFromEmail = Sheets("Email").Range("O5").Value
cfgNotice = Sheets("Email").Cells(rownum, 10) '10 = column J
cfgTemplate = Sheets("Email").Cells(rownum, 11) '11 = column K
htmlPath = "\\shared\drive\path\to\template\goes\here\" & cfgTemplate & ".htm"
Set appOutlook = CreateObject("Outlook.Application")
Set newEmail = appOutlook.CreateItem(olMailItem) 'Creates a blank email
If cfgNotice <> "null" Then 'If is not blank
MsgBox cfgNotice, vbInformation, "Before you send the email"
End If
With newEmail
.SentOnBehalfOfName = cfgFromEmail
.HTMLBody = HTMLtoString(htmlPath)
'Refer to and fill in variable items in template
'.Body = Replace(.Body, "<< clientname >>", Worksheets("Clients").Range(1, 2))
'.HTMLBody = Replace(.HTMLBody, "<< clientname >>", Worksheets("Clients").Range(1, 2))
.Display 'Show the email
End With
Set newEmail = Nothing
Set appOutlook = Nothing
End Sub
Function HTMLtoString(htmlPath As String)
'Returns a string after reading the contents of a given file
HTMLtoString = CreateObject("Scripting.FileSystemObject").OpenTextFile(htmlPath).ReadAll()
End Function
In case anyone's looking for solutions not involving parsing HTML tags, here's a relatively simple one. Make sure to have the Microsoft Word library referenced.
Dim myItem As Outlook.MailItem
Dim myInspector As Outlook.Inspector
Dim myDoc As Word.Document
Set myItem = _
Outlook.Application.CreateItemFromTemplate(TemplateName & ".oft")
.Display
Set myInspector = Application.ActiveInspector
Set myDoc = myInspector.WordEditor
myDoc.Bookmarks("_MailAutoSig").Range.Delete
I am trying to copy an entire sheet into an email body and the sheet is already filtered and hides rows. I want to copy only the visible rows into the email. I thought my code would do that but when the people reply to the emails, the entire sheet (both hidden and unhidden) appears in the email. Any ideas?
Sub Send_Range_Or_Whole_Worksheet_with_MailEnvelope()
'Working in Excel 2002-2013
Dim AWorksheet As Worksheet
Dim Sendrng As Range
Dim rng As Range
On Error GoTo StopMacro
With Application
.ScreenUpdating = False
.EnableEvents = False
.Application.DisplayAlerts = False
End With
'Fill in the Worksheet/range you want to mail
'Note: if you use one cell it will send the whole worksheet
Set Sendrng = Worksheets("Test").Range("A1").SpecialCells(xlCellTypeVisible)
'Remember the activesheet
Set AWorksheet = ActiveSheet
With Sendrng
' Select the worksheet with the range you want to send
.Parent.Select
'Remember the ActiveCell on that worksheet
Set rng = ActiveCell
'Select the range you want to mail
.Select
' Create the mail and send it
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
' Set the optional introduction field thats adds
' some header text to the email body.
.Introduction = "Test"
With .Item
.To = "test#email.com"
.CC = ""
.BCC = ""
.Subject = "Test"
.Send
End With
End With
'select the original ActiveCell
rng.Select
End With
This was essentially taken from this Example 2 of Ron de Bruin, with some code from another example.
The code below seems to work.
You will have to fill it in with Ranges selection/activation and other details as needed.
EDIT The final step is sending the email (as per an added request of the OP). DoEvents added thanks to an answer to Excel VBA: Sent Outlook email does not include pasted Range
Sub SendEmail()
Dim OutlookApp As Object
'Dim OutlookApp As Outlook.Application
Dim MItem As Object
'Dim MItem As Outlook.MailItem
'Create Outlook object
Set OutlookApp = CreateObject("Outlook.Application")
'Set OutlookApp = New Outlook.Application
Dim Sendrng As Range
Set Sendrng = Worksheets("Test").Range("A1").SpecialCells(xlCellTypeVisible)
Sendrng.Copy
'Create Mail Item
Set MItem = OutlookApp.CreateItem(0)
'Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = "test#email.com"
.Subject = "Test"
.CC = ""
.BCC = ""
'.Body = "a"
.Display
End With
SendKeys "^({v})", True
DoEvents
With MItem
.Send
End With
Set OutlookApp = Nothing
Set MItem = Nothing
End Sub
Since you did not state it is mandatory to use VBA (at least when this answer was first posted), you might:
Go to Home -> Find & Select -> Go To Special -> Visible cells only. Then copy and paste into your email. That worked for me.