PDA

View Full Version : Excel to Email with Attachment (1 line only at a time with button push)



DarinM
04-29-2015, 08:29 AM
Hi guys,

I am a complete noob when it comes to VBA, only have slight knowledge in HTML.

I found this macro online somewhere and have manipulated it to work for my application, however I would love it to be able to populate the email with the cells I want, AND attach an email from a specific location. The location will have multiple files so I will have to point exactly to it, which is not an issue...I can do that manual part. It would be great to have a column for CC emails as well, I can probably figure that part out...

The idea is to have a tracker, my sales managers have events coming up, and I will have visual indicator on when the dates are, and a reminder after 1 week ETC. However, once we hit 1 week to go, I would like to click on that row, select a few drop down messages (1 week reminder message, 1 day message) and ask them to confirm the information in the PDF. Currently the macro sends everything on the line you click, but I haven't been able to understand how to attach an email in this way. Hope you guys can follow along and help me out!

I need the attachment to look at a specific cell in the row I am at, not all of say all column J, or only J3, needs to be the code Cells(ActiveCell.Row, 11) or whatever.

Thanks!

Darin

Attached is the spreadsheet, and the code below.


Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long


Sub SendEMail()
Dim Email As String, Subj As String, Body As String
Dim Msg As String, URL As String, Attach As String

Attach = Cells(ActiveCell.Row, 10)

Email = Cells(ActiveCell.Row, 7)

Subj = Cells(ActiveCell.Row, 6)

Body = Cells(ActiveCell.Row, 9)


Msg = ""
Msg = Msg & "Hello " & Cells(ActiveCell.Row, 1) & "," & vbCrLf & vbCrLf & Body & vbCrLf & vbCrLf & Cells(ActiveCell.Row, 13) & vbCrLf & vbCrLf & " And here is some more precanned text in the macro AFTER the Body stuff."

'Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

'Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")

'Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

'Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus



'Wait two seconds before sending keystrokes
'Application.Wait (Now + TimeValue("0:00:02"))
'Application.SendKeys "%s"
End Sub

13279

Kenneth Hobs
04-30-2015, 01:54 PM
Welcome to the forum!

Do you mean that you want to use the mailto method to attach a file such as a PDF? If so, that method can not be used.

You call it Outlook, why not use that object? See: http://www.vbaexpress.com/forum/showthread.php?52440-Inserting-non-default-signature-with-picture-in-Outlook-e-mail

DarinM
05-01-2015, 05:31 AM
Hi Kenneth,

thanks for the welcome.

So you can't attach a file in an Outlook e-mail from excel? I thought for sure you could... I see that link, thank you, but i'm not sure i can see the solution through that. did you see my spreadsheet? I have the entire file path for the PDF so it's just attaching that line...

am I still incorrect?

thanks for the time

Kenneth Hobs
05-01-2015, 05:59 AM
As I said, the mailto method does not have a feature that allows attachments. Mailto is not an Outlook command. Mailto is good to use for simple tasks when you don't know which e-mail application is installed and want to send using the user's default application.

The Outlook object like Excel, has methods and properties. Ron DeBruin shows how to use it on his site. More Outlook examples are there at: http://www.rondebruin.nl/win/s1/outlook/mail.htm

Here is a quick snip from one of Ron's examples showing the attachment method.

Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
StrSubject As String, StrBody As String, Send As Boolean)
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 = StrTo
.CC = ""
.BCC = ""
.Subject = StrSubject
.Body = StrBody
.Attachments.Add FileNamePDF
If Send = True Then
.Send
Else
.Display
End If
End With
On Error GoTo 0


Set OutMail = Nothing
Set OutApp = Nothing
End Function

DarinM
05-01-2015, 06:06 AM
Hmm okay, I got you now.

Can I paste that inside the "sendmail" button macro? I want to send per line, not the entire thing. I'll take a stab at it in a bit but would be helpful if I can do that inside the button.

appreciate it

Kenneth Hobs
05-01-2015, 06:32 AM
Put that Function into a Module. Then in your button's Sub, it really boils down to a one-liner. You simply type the functions name, type a space character, and then add the value for each parameter (your Cells code for the active row) and separate each by a comma. The last parameter is a boolean type which means true or false to send it without review. I can do that for you if you like but you learn more doing it yourself.

I do most of my coding in a modular way like that so I can reuse the code often.

DarinM
05-15-2015, 06:35 AM
Hi Kenneth.

Ok so I have time to try this now, and I am not connecting the dots at all.

do you have an email address we could chat over? I used the Ron one, and replaced the attachment as my filename and it still isn't working.

I can't figure out how to put that macro inside the one with the button... appreciate the help...baby steps :)

DarinM
05-15-2015, 07:00 AM
actually, found out some stuff, working good MINUS, the attaching of the file. it works if I put the actual path name, but not the cell it's in, (either K3" or Cells(ActiveCell.Row, 11)

can you help? I am so close!!

Kenneth Hobs
05-15-2015, 07:51 AM
What is the value of the cell?

There are several methods to see if the file exists. I normally use Dir() and sometimes use FSO's FileExists method. Since On Error Resume Next is there, if the file does not exist, it skips that part as it would error.

I normally use Debug.Print to check values in the Immediate Window for a run or MsgBox. e.g.

Sub test()
Dim r As Range
Set r = Range("K" & ActiveCell.Row)

MsgBox "Address of active cell, column K: " & r.Address
MsgBox "Value of active cell, column K: " & r.Value
End Sub

From the cell's value, you can see whether it has the drive:\path\filename.ext set properly or if you need to concatenate some string to build it properly. Use & to concatenate strings.

So, you pass the value of the first parameter, you have to build the filename if it is not fully defined in the cell's value. e.g.

Sub Test_RDB_Mail_PDF_Outlook() 'Value of active cell's row, column K is: "ken" but file that exists is "C:\Letters\Self\ken.pdf".
RDB_Mail_PDF_Outlook "c:\letters\self\" & Range("K" & ActiveCell.Row).Value2 & ".pdf", _
"ken@gmail.com", "Note to World", "Hello World!", True
End Sub

Note that I like Range() since Intellisense works for it but Cells(activecell.row, 11).value or Cells(activecell.row, "K").value works fine too.

DarinM
05-15-2015, 08:29 AM
Value of the cell is now "test" , pathway to the file has changed slightly, its now; C:\Users\z003ev6p\Documents\CRM\test.txt

also, I made a new workbook to test this, and its not "TEST_RDB" etc, it's now just Workbook...I can't get your second part to work, the last bit of code you told me.

my new code is here...


Sub Mail_Workbook_1()' 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


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
.To = Cells(ActiveCell.Row, 11)
.CC = Cells(ActiveCell.Row, 12)
.BCC = ""
.Subject = Cells(ActiveCell.Row, 13)
.Body = Cells(ActiveCell.Row, 14)
.Attachments.Add Cells(ActiveCell.Row, 16)
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
.Display
'.Send
End With
On Error GoTo 0


Set OutMail = Nothing
Set OutApp = Nothing
End Sub




Sub test()
Dim r As Range
Set r = Range("P" & ActiveCell.Row)

MsgBox "Address of active cell, column P: " & r.Address
MsgBox "Value of active cell, column P: " & r.Value
End Sub


Sub Mail_Workbook_1() 'Value of active cell's row, column K is: "ken" but file that exists is "C:\Letters\Self\ken.pdf".
Mail_Workbook_1 "C:\Users\z003ev6p\Documents\CRM\" & Range("P" & ActiveCell.Row).Value2 & ".txt", _
"your email", "Note to Self", "Hello World!", True
End Sub

Kenneth Hobs
05-15-2015, 08:45 AM
Sounds like your file does not exist.

Sub ken()
Dim fn As String

fn = "w:\Hello World!.doc"
MsgBox fn & ": " & (Dir(fn) <> ""), vbInformation, "File Exists"

fn = "C:\Users\z003ev6p\Documents\CRM\" & Range("P" & ActiveCell.Row).Value2 & ".txt"
MsgBox fn & ": " & (Dir(fn) <> ""), vbInformation, "File Exists"
End Sub

DarinM
05-15-2015, 10:09 AM
Ok, when I add "test.txt" instead of ".txt" it works. The word "test" is in column P, so not sure why it's not adding it?


then I just tried doing this, and it says "true" - and column P has "test.txt" in it, then it goes true.

ahhhhhh! It works, played around with it more... code below :) - I will just have to tell people to copy/paste the file name exactly, with extension :)





Sub Mail_Workbook_1()' 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


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
.To = Cells(ActiveCell.Row, 11)
.CC = Cells(ActiveCell.Row, 12)
.BCC = ""
.Subject = Cells(ActiveCell.Row, 13)
.Body = Cells(ActiveCell.Row, 14)
.Attachments.Add "C:\Users\z003ev6p\Documents\CRM\" & Cells(ActiveCell.Row, 16).Value2 & ""
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
.Display
'.Send
End With
On Error GoTo 0


Set OutMail = Nothing
Set OutApp = Nothing
End Sub





edit; I am going to try and use two buttons to send stuff instead of one.....so I may reply again soon if it screws up, but I have a pretty good idea on what to do.

Thanks so much Ken!