I am writing a macro to send an e-mail from an excel sheet. The macro prepares a few reports and then has a function to prepare the e-mail for the report. Everything works fine except when it gets to the .Send line it gives me a run time error -2147467259. Not sure what this means, but would appreciate the help.
Here is the code for the function:
Function Mail_Reports(ByRef wkDate2 As String, fileDate2 As String, wkNumber2 As String, thisYear2 As String)
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .
Dim OutApp As Object
Dim OutMail As Object
Dim mailList As String
Dim i As Long, lstRow As Long, p As Long, addressNum As Long, begRow As Long
Dim proNam2 As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'On Error Resume Next
' Change the mail address and subject in the macro before you run it.
For i = 1 To 5 Step 1
mailList = ""
lstRow = Sheets("Data").Cells(Rows.Count, i).End(xlUp).Row
addressNum = lstRow - 16
begRow = lstRow - addressNum
proNam2 = Sheets("Data").Cells(16, i)
proNam2 = Replace(proNam2, " ", "")
For p = 1 To addressNum Step 1
mailList = Sheets("Data").Cells(begRow + p, i) & " ; " & mailList
Next p
With OutMail
.To = mailList
'.CC = "" remove comma and use this if you want to cc anyone, can be string or variable
'.BCC = "" remove comma and use this if you want to cc anyone, can be string or variable
.Subject = "Test"
.HTMLBody = "<HTML><BODY><Font Face=Calibri(Body)><p>Hi All,</p><p2>Attached to this e-mail is the test file.<p2/><br><br><p3>Best,<p3/></font></BODY></HTML>"
.attachments.Remove 1
.attachments.Add "C:\Documents and Settings\test.xlsx"
.Display
.Send
Next i
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Function
Can you please try with just,
Save the report file into a local drive
use one email address first, so remove the for loop
send it with just one file/range/workbook.
remove html tags for signature or etc..
Code:
With WB '-- workbook
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "myname#myname.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Here is a Report on My VBA analysis"
.Attachments.Add Dest.FullName
'You can add other files also like this
'.Attachments.Add ("C:\testmail.txt") '-- .xls
.Send 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Update based on the comments with OP:
Looking at your email concat loop, you do not have to do it each time when a new book comes UNLESS YOUR MAILING LIST DIFFERS FOR EACH WORKBOOK.... You may take that loop out of the mail workbooks iteration.
For p = 1 To addressNum Step 1
mailList = Sheets("Data").Cells(begRow + p, i) & " ; " & mailList
Next p
One problem I can see here is that you do the following:
Set OutMail = OutApp.CreateItem(0)
outside the send loop. You should move that here:
[...]
For p = 1 To addressNum Step 1
mailList = Sheets("Data").Cells(begRow + p, i) & " ; " & mailList
Next p
Set OutMail = OutApp.CreateItem(0)
With OutMail
[...]
I can't comment on your specific error because I don't know what data is going into your OutMail object. However, to help you debug, I recommend you:
Close the With OutMail block with an End With
Set a reference to Microsoft Outlook 14.0 Object Library
Declare OutApp as Outlook.Application (Dim OutApp as Outlook.Application)
Declare OutMail as Outlook.MailItem (Dim OutMail as Outlook.MailItem)
Initialise OutApp as follows: Set OutApp = New Outlook.Application
The above are not necessary (except maybe closing your With OutMail block) but may help you to diagnose problems with your code.
Also note that if you're using a newer version of Outlook, other applications (Excel, Word, Access etc.) may be prevented from sending by security controls: http://support.microsoft.com/kb/263084.
Related
I am trying to send an email through vba in excel, all works fine excpect the email attachement. It doesnt seem to link it. Where could be the issue ?
The string attach is pointing to the right file.
Dim OutApp As Object
Dim OutMail As Object
Dim email
Dim attach
email = writeEmailAddress()
attach = attachement()
Sheets("Mail").Range("B1") = email
Sheets("Mail").Range("B2") = "xxxxxx"
Sheets("Mail").Range("B3") = "xxxxxxx"
Sheets("Mail").Range("B4") = attach
MsgBox attach
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.SendKeys "^{ENTER}"
.to = "xxxxx"
.CC = ""
.BCC = ""
.Subject = Sheets("Mail").Range("B5").Value
.Body = Sheets("Mail").Range("B6").Value
'You can add other files also like this
.Attachments.Add attach ' <--------------------------------This is causing troubble
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Change,
.Attachments.Add attach
... to,
If CBool(Len(Dir(attach, vbNormal))) Then
.Attachments.Add attach, 1 '<~~ 1 is olByValue
Else
Debug.Print "Cannot find '" & attach & "'"
End If
If the attachment is not added to your email item, check the VBE's Immediate Window (e.g. Ctrl+G) for the error message.
The following is a simple code that will send an email using whatever email program is open. My problem is that I would like to add three emails to the list but outlook 2013 only recognizes it if I have one address.
What is the correct format for outlook?
Application.Dialogs(xlDialogSendMail).Show _
arg1:="attributes#hotmail.ca", _
arg2:="East attributes" & Now()
I have tried
Application.Dialogs(xlDialogSendMail).Show _
arg1:="attributes#hotmail.ca" & ";" & "runaway#gmail.com", _
arg2:="East attributes" & Now()
Here is a very basic example of how to automate Outlook from Excel. Please note I am using LateBinding.
Option Explicit
Sub Sample()
Dim OutApp As Object
Dim OutMail As Object
Dim MyFileList(1) As String
Dim i As Long
'~~> Change/Add the file names here
MyFileList(0) = "C:\Sample1.xlsx"
MyFileList(1) = "C:\Sample2.xlsx"
'~~> Create a new instance of outlook
Set OutApp = CreateObject("Outlook.Application")
'~~> Create a new Email
Set OutMail = OutApp.CreateItem(0)
'~~> Set the To/CC/BCC etc here
With OutMail
.To = "MyEmail1#123.com" & ";" & "MyEmail2#123.com" & ";" & "MyEmail3#123.com"
.CC = "MyEmail4#123.com"
.Bcc = "MyEmail5#123.com"
.Subject = "Example for attaching 2 files"
.Body = "Hi Russel :)"
'~~> Attaching file
For i = LBound(MyFileList) To UBound(MyFileList)
.Attachments.Add MyFileList(i)
Next i
'~~> Display the email. To send the email, Change the below to .Send
.Display
End With
End Sub
ScreenShot:
You can automate Outlook from Excel to get the job done. See How to automate Outlook from another program for more information.
Use the Recipients collection to specify the To, CC or Bcc recipients.
I'm attempting to send an email containing an Excel workbook from within the document using the built in VB macros. There is data in one of the sheets, which are relevant to sending the email (Subject, recipient etc). I am trying to access these using the Sheets object like so
Sub Button1_Click()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Dim cell As Object
Dim count As Integer
count = 0
For Each cell In Selection
count = count + 1
Next cell
If count <> 1 Then
MsgBox ("You must select exactly one cell, which shall be the e-mail address of the recipient")
Wscript.Quit
Else
recipient = ActiveCell.Value
End If
On Error Resume Next
With OutMail
.To = recipient
.CC = ""
.BCC = ""
.SentOnBehalfOfName = This.Sheets("MailContent").Range("A2").Value
.Subject = This.Sheets("MailContent").Range("A4").Value
.Body = This.Sheets("MailContent").Range("A6").Value & vbNewLine & This.Sheets("MailContent").Range("A7") & vbNewLine & vbNewLine & "Næste gang senest den " + This.Sheets("MailContent").Range("A10") & vbNewLine & vbNewLine & This.Sheets("MailContent").Range("A8")
.Attachments.Add ActiveWorkbook.Name
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I've also been able to replicate the same error with this small snippet
Sub Button1_Click()
Dim subjectCell As Range
subjectCell = This.Sheets("MailContent").Range("A2")
MsgBox (subjectCell.Value)
End Sub
I've tried using WorkSheets, Sheets, ActiveWorkbook to access the cells, but I'm sure it's just a problem of how I assign the data, since I'm not used to languages with syntax like VB. Any help is much appreciated, and if you need more info leave me a comment.
You need to use the 'Set' keyword to assign to a range.
Set subjectCell = ThisWorkbook.Sheets("MailContent").Range("A2")
This still catches me out on an irritatingly regular basis.
This sub in an Excel VBA application that has worked well for years, inserting an Outlook signature into an email before displaying the email for me to send (.Display). This has worked in Excel 2007 in Windows XP and 2013 in Windows 7.
Now I have Windows 8.1 and Office 2013 this comes out with Error 91 in my error routine. Could it be a problem with one of the References? - or some change needed in the code?
Sub InsertSig2007(strSigName As String)
Dim objItem As Object
Dim objInsp As Outlook.Inspector
' requires a project reference to the
' Microsoft Office library
Dim objCBP As Office.CommandBarPopup
Dim objCBP2 As Office.CommandBarPopup
Dim objCBB As Office.CommandBarButton
Dim colCBControls As Office.CommandBarControls
Set objInsp = ActiveInspector
If Not objInsp Is Nothing Then
Set objItem = objInsp.CurrentItem
If objItem.Class = olMail Then
' get Insert menu
Set objCBP = objInsp.CommandBars.ActiveMenuBar.FindControl(, 30005)
' get Signature submenu
Set objCBP2 = objCBP.CommandBar.FindControl(, 5608)
If Not objCBP2 Is Nothing Then
Set colCBControls = objCBP2.Controls
For Each objCBB In colCBControls
Debug.Print objCBB.Caption
If objCBB.Caption = strSigName Then
objCBB.Execute ' **** see remarks
Exit For
End If
Next
End If
End If
End If
Set objInsp = Nothing
Set objItem = Nothing
Set colCBControls = Nothing
Set objCBB = Nothing
Set objCBP = Nothing
Set objCBP2 = Nothing
End Sub
"this comes out with Error 91 in my error routine" When debugging do not use an error routine. That way you see the line with the problem and can say what it is in your question.
It is probably
Set objCBP = objInsp.CommandBars.ActiveMenuBar.FindControl(, 30005)
See CommandBars.FindControl Method (Office)
"The use of CommandBars in some Microsoft Office applications has been superseded by the new ribbon component of the Microsoft Office Fluent user interface."
Note: CommandBars.ExecuteMso Method (Office) works in 2013 but I believe the signature button is not available.
You will surely find a replacement for your code here Insert Outlook Signature in mail.
Likely this one:
Sub Mail_Outlook_With_Signature_Html_2()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2013
'Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim SigString As String
Dim Signature As String
'Set OutApp = CreateObject("Outlook.Application")
'Set OutMail = OutApp.CreateItem(0)
Set OutMail = CreateItem(0)
strbody = "<H3><B>Dear Customer Ron de Bruin</B></H3>" & _
"Please visit this website to download the new version.<br>" & _
"Let me know if you have problems.<br>" & _
"Ron's Excel Page" & _
"<br><br><B>Thank you</B>"
'Change only Mysig.htm to the name of your signature
SigString = Environ("appdata") & _
"\Microsoft\Signatures\Mysig.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
With OutMail
'.To = "ron#debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = strbody & "<br>" & Signature
'.Send
'or use
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
'Set OutApp = Nothing
End Sub
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
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
I have a macro for Outlook where I can create a complete mail with an attachment but can not add a signature saved in my C drive (C:\Users\JustinG\AppData\Roaming\Microsoft\Signatures).
Signature types are .rtf and .htm with images.
The following is the code:
Sub Mail_Workbook_1()
Dim OutApp As Object
Dim Outmail As Object
Set OutApp = CreateObject("Outlook.Application")
Set Outmail = OutApp.CreateItem(0)
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
With Outmail
.SentOnBehalfOfName = "justin.gatlin#rediffmail.com"
.To = "abc#xyz.com"
.CC = ""
.BCC = ""
.Subject = "Presentation"
.Body = "Hi Team,"
.Attachments.add ("C:\Users\DurshetwarA\Desktop\Excel Examination_Master_V1.xlsx")
.display
''SendKeys ("%s")
End With
On Error GoTo 0
Set Outmail = Nothing
Set OutApp = Nothing
End Sub
In the .htm file in the signatures directory you can edit the htm file. The pictures are stored as relative path and when you use the code it looses that path so if you use discrete path it will be able to find the pictures. so go into the file and look for any relative paths and make them discrete.
"/Microsoft/Signatures/picturefile.jpg"
change that to include the whole path
"/root/user/blah blah../Microsoft/Signatures/picturefile.jpg"
This solved the missing image problem for me.
Solution described here by Ron de Bruin.
Sub Mail_Outlook_With_Signature_Html_2()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2013
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim SigString As String
Dim Signature As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<H3><B>Dear Customer Ron de Bruin</B></H3>" & _
"Please visit this website to download the new version.<br>" & _
"Let me know if you have problems.<br>" & _
"Ron's Excel Page" & _
"<br><br><B>Thank you</B>"
'Change only Mysig.htm to the name of your signature
SigString = Environ("appdata") & _
"\Microsoft\Signatures\Mysig.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = strbody & "<br>" & Signature
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
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
Instead of .body use .htmlbody and design your message body in HTML. This is the only way of inserting image in your message. There is no specific option to insert signature
Similar to the solution posted by Adavid02, here you may find a more detailed explanation.