I have been looking for a VBA that can send the entire workbook.
I found this
Sub Mail()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "mymail#domain.com"
.CC = ""
.BCC = ""
.Subject = Range("A1").Value
.body = ""
.Attachments.Add ActiveWorkbook.FullName
.send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
But when opening the sent mail, the workbook is all empty. So I have to save the workbook before using VBA.
Is there a workaround for this, so it just work as normal File -> Save and send -> Send as attachment?
I'm assuming you don't want to save it so work with [ Application.Dialogs MSDN ]
Example 1
Option Explicit
Public Sub example()
Application.Dialogs(xlDialogSendMail).Show _
arg1:="mymail#domain.com", _
arg2:=Range("A1").Value
End Sub
Example 2 [ Workbook.SendMail MSDN ] Sends the workbook using installed mail system
Option Explicit
Public Sub example()
ActiveWorkbook.SendMail _
Recipients:=Array("mymail#domain.com", "mymail#domain.com"), _
Subject:=Range("A1").Value
End Sub
Or save your workbook before sending.
Example
ActiveWorkbook.Save
.Attachments.Add ActiveWorkbook.FullName
.send
Related
I am trying to send an email by pressing a button. Everything works fine other than the body of the email. It always shows up blank. The body is being typed into TextBox1 (NOT User Form). I was hoping that putting it in a textbox would format it when sending the email.
Sub Email()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim ChartName As String
Set OutApp = CreateObject("Outlook.Application")
ChartName = Environ$("temp") & "\Chart4.gif"
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
ActiveWorkbook.Worksheets("Send Email").ChartObjects("Chart 4").Chart.Export _
Filename:=ChartName, FilterName:="GIF"
With OutMail
.To = Range("A2")
.CC = ""
.BCC = ""
.Subject = Range("A4")
'.body is the only thing not working it always shows up blank
.Body = Worksheets("Send Email").TextBox1.Value
.Attachments.Add ChartName
.Display 'will use send when working
End With
On Error GoTo 0
Kill ChartName
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
An Outlook email is generated whenever I execute a VBA code in Excel. It does not automatically send, nor do I want it to. The email is populated by cell values in a range (which are based off of the ActiveCell) and I want to programmatically capture when the email is manually sent into ActiveCell.Offset(0, 13), preferably with VBA in my current Excel program.
This is the code by which I display the email:
'Send Stock Request:
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.BodyFormat = olFormatHTML
.HTMLBody = "My eMail's HTML Body"
.To = "myrecipients#theiremails.com"
.CC = ""
.BCC = ""
.Subject = "Stock Request"
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
It can be done through VBA, but code below must be pasted in Outlook module instead of Excel, in Outlook=>ThisOutlookSession module. Also, make sure you allow macros in Outlook.
Private Sub Application_ItemSend(ByVal olItem As Object, Cancel As Boolean)
Dim Xl As Object ' Excel.Application
Dim Wb As Object ' Excel.Workbook
Set Xl = GetObject(, "excel.application")
Set Wb = Xl.Workbooks("NameOfYourOpenedWorkbook.xlsb")
Wb.Activate
Xl.activecell.Offset(0, 13).Value = Date & " " & Time
End Sub
So now when you send your automatically created email manually, you will get date and time captured in your opened Workbook in ActiveCell.Offset(0, 13) cell.
Add a VBA project reference to the Outlook object model, and add this class to your excel file:
''clsMail
Option Explicit
Public WithEvents itm As Outlook.MailItem
Public DestCell As Range '<< where to put the "sent" message
'you can add other fields here if you need (eg) to
' preserve some other info to act on when the mail is sent
Private Sub itm_Send(Cancel As Boolean)
Debug.Print "Sending mail with subject: '" & itm.Subject & "'"
DestCell.Value = "Mail sent!" '<< record the mail was sent
End Sub
Then in your Mail-sending code you can do something like this:
Option Explicit
Dim colMails As New Collection
Sub Tester()
Dim OutApp As Object
Dim OutMail As Object
Dim obj As clsMail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.BodyFormat = olFormatHTML
.HTMLBody = "My eMail's HTML Body"
.To = "twilliams#theravance.com"
.CC = ""
.BCC = ""
.Subject = "Stock Request"
.Display
End With
'create an instance of the class and add it to the global collection colMails
Set obj = New clsMail
Set obj.itm = OutMail
Set obj.DestCell = ActiveCell.Offset(0, 13) '<< "sent" flag goes here
' when the user sends the mail
colMails.Add obj
End Sub
I am trying to loop through a set of worksheets, save each of them as a separate workbook, and then send them as attachment by mail.
However when running the below code, I end up with error 287 triggered by .Send. I have outlook open, so that is not the problem. If I change .Send to .Display, the mails are generated as drafts as displayed properly with the correct sheet attached.
Sub SendWorksheetsByMail()
Dim wb As Workbook
Dim destinationWb As Workbook
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Set wb = Workbooks("Test.xlsm")
Application.EnableEvents = False
Application.ScreenUpdating = False
For Each ws In wb.Worksheets
'Ignore Summary and Config
If ws.Name <> "Summary" And ws.Name <> "Config" Then
'On Error Resume Next
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
ws.Copy
Set destinationWb = ActiveWorkbook
destinationWb.SaveAs "C:\****************\" & ws.Name & ".xlsx", FileFormat:=51
With OutMail
.To = "*******************"
.Subject = "Test"
.Body = "Test"
.Attachments.Add destinationWb.FullName
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End If
Next ws
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Edit: "It also fails even without an attachment. Essentially generating a message containing only the subject and text "test"."
Any suggestions for how to solve this? It would save a lot of time to not have to click Send for each individual mail, as the number of mails to send could potentially become quite large.
This is what I used to send a mail with attachment to multiple addresses, listed in column H while the name of the receiver is listed in another column
Sub Mail()
'####################################
'### Save the file as pdf ######
'####################################
Dim FSO As Object
Dim s(1) As String
Dim sNewFilePath As String
Set FSO = CreateObject("Scripting.FileSystemObject")
s(0) = ThisWorkbook.FullName
If FSO.FileExists(s(0)) Then
'//Change Excel Extension to PDF extension in FilePath
s(1) = FSO.GetExtensionName(s(0))
If s(1) <> "" Then
s(1) = "." & s(1)
sNewFilePath = Replace(s(0), s(1), ".pdf")
'//Export to PDF with new File Path
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sNewFilePath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
Else
'//Error: file path not found
MsgBox "Error: this workbook may be unsaved. Please save and try again."
End If
Set FSO = Nothing
'##########################################
'### Attach the file and mail it ######
'##########################################
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("sheet")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("H").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*#?*.?*" Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = "file delivery "
.Body = "Hi " & cell.Offset(0, -3).Value & " here is my file"
.Attachments.Add sNewFilePath
.Send 'Or use .Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Try .GetInspector before .Send. It would be like .Display without displaying.
I found a two step soultion. By changing .Send to .Display in the code above, the messages will be created as drafts in outlook and Displayed. If you do not want an extra window per e-mail, changing .Display to .Save will just put them in the draft folder.
Then I can use a macro written in Outlook to send all drafts. Code based on solution found at the mrexcel forums.
I also discovered after reading this answer on SO that the drafts folder can not be selected when running the macro.
Hope this helps others running into the same problem.
Public Sub SendDrafts()
Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder
'Send all items in the "Drafts" folder that have a "To" address filled in.
'Setup Outlook
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders
'Set Draft Folder.
Set myDraftsFolder = myFolders("*******#****.com").Folders("Drafts")
'Loop through all Draft Items
For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1
'Check for "To" address and only send if "To" is filled in.
If Len(Trim(myDraftsFolder.Items.Item(lDraftItem).To)) > 0 Then
'Send Item
myDraftsFolder.Items.Item(lDraftItem).Send
End If
Next lDraftItem
'Clean-up
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing
End Sub
Might be a good idea to add code that differntiates the messages you are trying to send from other drafts that may already be in the folder.
Would still prefere a one step solution, so I will wait with marking this as a solution.
I finally found the answer googling a lot.
The problem is not with the .send method, but rather the session object.
Replace Set myOutlook = Outlook.Application with
Set objOutlook = ThisOutlookSession
This ensures that your macro is using the same outlook session that is open. Atleast it did the trick for me
I have a code that I've been using forever to automatically email a workbook via a commandbutton click. I tried to reformat this code to send 2 individual sheets (named: Pass, Pass Screenshot) from the workbook, but I can't get it to work. The sheets won't be active when the email is sent. This is the code I've been using, any help would be greatly appreciated:
Sub SendEmail()
ThisWorkbook.Save
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = "my email"
.Subject = "my subject" & Date
.Attachments.Add '???
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
The Attachments.Add method takes a file path argument, you can't reconfigure that to send a worksheet (or array of worksheet) object. What you can do is export those two sheets in to a new/temporary file, send as attachment, and then remove/kill the temporary file which is no longer needed.
Sub SendEmail()
Dim OutApp As Object
Dim OutMail As Object
Dim tempWB as Workbook
Dim tempFile as String
Dim wb as Workbook
tempFile = Environ("Temp") & "\sheets_copy.xlsx"
Set wb = ThisWorkbook
wb.Save
' The Sheets.Copy method will create a new workbook containing the copied sheets
wb.Sheets(Array("Pass", "Pass Screenshot")).Copy
Set tempWB = ActiveWorkbook
' ensure no temp wb already exists
' this can technically still fail if the file is open/locked
If Len(Dir(tempFile)) <> 0 Then
Kill tempFile
End If
' Save & close the tempFile
tempWB.SaveAs tempFile
tempWB.Close
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = "my email"
.Subject = "my subject" & Date
.Attachments.Add tempFile '## Add your attachment here
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I have to create and send an Excel file every month via email to my boss.
I want to use a VBA code to send the file as attachment, but my VBA code doesn't work and asks for debug after confirmation.
My code:
Sub EMail()
ActiveWorkbook.SendMail Recipients:="user#gmail.com"
End Sub
Credit where credit is due... This is straight from the Ron de Bruin website.
Sub Mail_workbook_Outlook_1()
'Working in Excel 2000-2016
'This example send the last saved version of the Activeworkbook
'For Tips see: https://www.rondebruin.nl/win/s1/outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = "ron#debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Here is an example on how to send Active Workbook as attachment
Option Explicit
Sub EmailFile()
Dim olApp As Object
Dim olMail As Object
Dim olSubject As String
' // Turn off screen updating
Application.ScreenUpdating = False
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(olMailItem)
olSubject = "This Subject Line"
With olMail
.Display
End With
With olMail
.To = "0m3r#EMail.com"
.CC = ""
.BCC = ""
.Subject = olSubject
.HTMLBody = "This Body Text " & .HTMLBody
.Attachments.Add ActiveWorkbook.FullName
'.Attachments.Add ("C:\test.txt") ' add other file
' .Send 'or use .Display
.Display
End With
' // Restore screen updating
Application.ScreenUpdating = True
Set olMail = Nothing
Set olApp = Nothing
End Sub
You can use the VBA code snippet as shown in the following sample:
Sub SendEmailWithAttachment()
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set myItem = Application.CreateItem(olMailItem)
Set myAttachments = myItem.Attachments
myAttachments.Add "C:\MyExcelFile.xls", olByValue, 1, "Test"
myItem.To = "Recipient Address"
myItem.Send
'alternatively, you may display the item before sending
'myItem.Display
End Sub
Hope this may help.