I created a macro to send multiple invoices one per email, it worked but I need email subject to be only a part of the file name. it worked with the first file but then it is always taking that as fixed.
I tried to "do while" with second var (file1) but didn´t work.
(file name for reference: US21_US61_0000_6460069666_YBF2_6203963322_ZB34_00_0)
Sub todo()
'Outlook should be opened
Dim OutApp As Object
Dim OutMail As Object
'Opens APP Outlook
Set OutApp = CreateObject("Outlook.Application")
On Error Resume Next
'Improve performance
Application.ScreenUpdating = True
'Path from the computer where it is used
mypath = "C:\Users\natudiaz\Downloads\Invoices\US\"
'Takes files from extension consider pdf or excel
myfile = Dir(mypath & "*.pdf*")
myfile1 = Mid(myfile, 16, 10)
Do While myfile <> ""
'Makes iterations
'Creates email
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "natudiazci#gmail.com"
.CC = ""
.BCC = ""
.Subject = "INV:" + myfile1
.Body = "To the Team"
.Attachments.Add (mypath + myfile)
.Display
.Send
.ReadReceiptRequested = True
End With
'Next
myfile = Dir
Loop
Application.ScreenUpdating = False
End Sub
I created a macro to send multiple invoices one per email, it worked but I need email subject to be only a part of the file name. it worked with the first file but then it is always taking that as fixed.
I tried to "do while" with second var (file1) but didn´t work.
That is because you get the file name for the subject once and then iterate over all files. But instead, you need to get the file name for the subject line in the loop with creating emails.
Do While myfile <> ""
myfile1 = Mid(myfile, 16, 10)
'Makes iterations
'Creates email
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "natudiazci#gmail.com"
.CC = ""
.BCC = ""
.Subject = "INV:" + myfile1
.Body = "To the Team"
.Attachments.Add (mypath + myfile)
.ReadReceiptRequested = True
.Send
End With
'Next
myfile = Dir
Loop
Note, I've removed the Display call which is not required if you send items immediately. Also I've moved the ReadReceiptRequested property before the Send call. No actions should be taken on the submitted item.
This
myfile1 = Mid(myfile, 16, 10)
Should go inside the do loop, not outside, as outside is only calculated for the first file.
Related
I am trying to embed a range from a worksheet as an image in outlook mail body. It's saving the picture correctly but I only see blank image in the outlook mail body. What am I doing wrong here?
Sub View_Email()
tName = Trim(MAIN.Range("tEmail"))
If Not tName Like "*#*.*" Then MsgBox "Invalid Email address": Exit Sub
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'File path/name of the gif file
Fname = ThisWorkbook.Path & "\Claims.jpg"
Set oCht = Charts.Add
STAT.Range("A3:G26").CopyPicture xlScreen, xlBitmap
With oCht
.Paste
.Export Filename:=Fname, Filtername:="JPG"
'.Delete
End With
On Error Resume Next
With OutMail
.To = tName
.CC = ""
.BCC = ""
.Subject = STAT.Range("C1").Value
.HTMLBody = "<html><p>Summary of Claim Status.</p>" & _
"<img src=" & Fname & "' height=520 width=750>"
.display
'.Send 'or use .Display
End With
On Error GoTo 0
'Delete the gif file
'Kill Fname
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
You need to add the image and hide it. The position 0 will add and hide it.
.Attachments.Add Fname, 1, 0
The 1 is the Outlook Constant olByValue
Once you add the image then you have to use "cid:FILENAME.jpg" as shown below.
Try this
With OutMail
.To = tName
.CC = ""
.BCC = ""
.Subject = STAT.Range("C1").Value
.Attachments.Add Fname, 1, 0
.HTMLBody = "<html><p>Summary of Claim Status.</p>" & _
"<img src=""cid:Claims.jpg""height=520 width=750>"
.Display
End With
Screenshot
You need to set the PR_ATTACH_CONTENT_ID MAPI property (DASL name "http://schemas.microsoft.com/mapi/proptag/0x3712001F") using Attachment.PropertyAccessor.SetProperty and refer that attachment through the src attribute that matches the value of PR_ATTACH_CONTENT_ID set on the attachment. PR_ATTACH_CONTENT_ID corresponds to the Content-ID MIME header when the message is sent.
attachment = MailItem.Attachments.Add("c:\temp\MyPicture.jpg")
attachment.PropertyAccessor.SetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F", "MyId1")
MailItem.HTMLBody = "<html><body>Test image <img src=""cid:MyId1""></body></html>"
Keep in mind that setting content-id is preferable to using the attachment file name in the <img> element since it would need to be properly encoded and (if I remember correctly) some e-mail clients have a problem with just using the attachment file name for images.
I am sending emails out to approximately 150 individuals, each email may have between 1 and 3 attachments.
I can send emails out just fine with one attachment...getting multiple attachments is difficult.
Lets say the attachment file path is located in A1 through C1.
How can I Perform.
If A1 is empty, go to Send, if not, attach file
If B1 is empty, go to Send, if not, attach file
If C1 is empty, go to Send, if not, attach file
Send:
This is the code I have currently: I realize my ranges are different than what I posted above. The following script works...its just for the one attachment however.
Set rngEntries = ActiveSheet.Range("b5:b172")
For Each rngEntry In rngEntries
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = rngEntry.Offset(0, 11).Value
.Subject = rngEntry.Offset(0, 8).Value
.Body = rngEntry.Offset(0, 10).Value
.Attachments.Add rngEntry.Offset(0, 9).Value
.send
End With
Next rngEntry
What I want would look a little like this....
Set rngEntries = ActiveSheet.Range("b5:b172")
For Each rngEntry In rngEntries
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = rngEntry.Offset(0, 11).Value
.Subject = rngEntry.Offset(0, 8).Value
.Body = rngEntry.Offset(0, 10).Value
If rngEntry.Offset(0, 1) is empty, goto Send
.Attachments.Add rngEntry.Offset(0, 1).Value
If rngEntry.Offset(0, 2) is empty, goto Send
.Attachments.Add rngEntry.Offset(0, 2).Value
If rngEntry.Offset(0, 3) is empty, goto Send
.Attachments.Add rngEntry.Offset(0, 3).Value
Send:
.send
End With
Next rngEntry
It's always best to avoid GoTo statements in VBA at all costs, because things can get hairy very quickly. Just write this:
If Not IsEmpty(rngEntry.Offset(0, 1)) Then .Attachments.Add rngEntry.Offset(0, 1).Value
If Not IsEmpty(rngEntry.Offset(0, 2)) Then .Attachments.Add rngEntry.Offset(0, 2).Value
If Not ISEmpty(rngEntry.Offset(0, 3)) then .Attachments.Add rngEntry.Offset(0, 3).Value
Additional Info
You may also be interested in a function I built to send emails, which passes attachments as a | separated string values and then splits them into an array to load them. In this way, you can send one or more with the same function, plus a few other nifty things.
A few notes: I declared Outlook outside the function in the capacity I was using it, so you'd have to either do the same, or add it into the function. It also uses Early Binding as I use inside other MS Office Products.
Option Explicit
Sub SendMail(strTo As String, strSubject As String, strBody As String, strAttachments As String, Optional strCC As String, Optional strFolder As String, Optional blSend As Boolean)
'requires declaration of Outlook Application outside of sub-routine
'passes file name and folder separately
'strAttachments is a "|" separate listed of attachment paths
Dim olNs As Outlook.Namespace
Dim oMail As Outlook.MailItem
'login to outlook
Set olNs = oApp.GetNamespace("MAPI")
olNs.Logon
'create mail item
Set oMail = oApp.CreateItem(olMailItem)
'display mail to get signature
With oMail
.Display
End With
Dim strSig As String
strSig = oMail.HTMLBody
'build mail and send
With oMail
.To = strTo
.CC = strCC
.Subject = strSubject
.HTMLBody = strBody & strSig
Dim strAttach() As String, x As Integer
strAttach() = Split(strAttachments, "|")
For x = LBound(strAttach()) To UBound(strAttach())
If FileExists(strFolder & strAttach(x)) Then .Attachments.Add strFolder & strAttach(x)
Next
.Display
If blSend Then .Send
End With
Set olNs = Nothing
Set oMail = Nothing
End Sub
Here is the FileExists that checks if the attachment exists before trying to add it:
Function FileExists(sFile As String) As Boolean
'requires reference to Microsoft Scripting RunTime
Dim fso As FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(sFile) Then
FileExists = True
Else
FileExists = False
End If
Set fso = Nothing
End Function
I have the following code which lets me prepare an email which is ready to be sent:
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = ThisWorkbook.Sheets("Users").Range("A1").Value
.CC = ""
.BCC = ""
.Importance = 2
.Subject = "[ACTION REQUIRED] Format(Date, "YYYYMMDD")"
.HTMLBody = "some_body"
.Display
End With
and here is the Users table:
Users Johnson, Jerry Mullen, Carl Mullen, Carl Mullen, Carl Terry, Mark Carlos, Juan
I need to create a macro which lets me prepare an email but my main problem is I don't know how to add recipients using data from Users table.
My current code is not allowing me to attach anything aside from string values (typed directly, or maybe I'm doing something wrong).
I also need it to not attach names that are duplicated.
The following code assumes that you have your users' names in your outlook contact list, and that they are located in the cells A2 and down, but that range can be altered.
Sub test()
Dim users As New Collection
Dim usrRng As Range
Dim recipients As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set usrRng = Range("A2", Range("A2").End(xlDown))
Application.ScreenUpdating = False
On Error Resume Next
For Each cell In usrRng
users.Add cell.Value, cell.Value
Next cell
On Error GoTo 0
For Each usrName In users
recipients = recipients & usrName & "; "
Next usrName
With OutMail
.To = recipients
.CC = ""
.BCC = ""
.Importance = 2
.Subject = "[ACTION REQUIRED] " & Format(Date, "YYYYMMDD")
.HTMLBody = "some_body"
.Display
End With
Application.ScreenUpdating = True
End Sub
What this does, is that it takes each name in the range A2 and down, and adds it to a collection, skipping the duplicates.
Then we make a string, which will be made out of each name we just added to the collection, seperating each name with a ";".
Then we pass that new string to the OutMail object as the receiver of the message.
When the new mail is displayed, the names will not be recognized, but if press send, the mail should be sent to the correct people, assuming you don't have multiple contacts with the same name.
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.
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.