Code for emailing Excel workbooks will only attach activeworkbook

[pickytweety]

Hi,
Ok so when a non-programmer tries to take code and "tweak it" for a
different use...here's what happens....it doesn't work. Can anyone help?
What I've got is an Excel file I'm using as a template. I run a macro (not
the one below) to create a report for Zone 1. I save the file with a name
like "December report - Zone 1". Then I run the macro for Zone 2 and save
the file with a name like "December report - Zone 2" and so on for many
zones. Within the Excel file there is a sheet called Email. On the Email
sheet, starting with row 13, column A has a list of email addresses, column B
--too hard to explain, column C has the file name (as given in the example
above.) I want the macro below to email the file (found in col C) to the
corresponding rows email address found in column A. The problem is, it is
only working when I try to email the activeworkbook, not the files I already
saved off. How come? I made notes to the right of the code below that help
explain my problem.
--
Thanks,
PTweety


Option Explicit
Dim strEmail As String
Dim strFileName As String
Const listStartCell As String = "A13"

Sub EmailList()
application.ScreenUpdating = False
application.EnableEvents = False

Dim rngEmailList As Range, rngEmailItem As Range
Set rngEmailList = Range(listStartCell,
Me.Cells.SpecialCells(xlCellTypeLastCell))

For Each rngEmailItem In rngEmailList
If Not rngEmailItem(, 2) = "Y" Then GoTo NextEmailItem
strEmail = rngEmailItem(, 1)
strFileName = rngEmailItem(, 3)

Dim appOutlook As Object, objEmail As Object
Set appOutlook = CreateObject("Outlook.Application")
appOutlook.Session.Logon
Set objEmail = appOutlook.CreateItem(0)


On Error Resume Next
With objEmail
.To = strEmail
.Subject = swapVariables(Me.Range("B5"))
.Body = swapVariables(Me.Range("B6"))
'.Attachments.Add ActiveWorkbook.FullName 'This one
works--but I don't always want to add the template workbook
'.Attachments.Add (swapVariables(Me.Range("b7"))) 'this one doesn't
'.Attachments.Add swapVariables(strFileName) 'this one doesn't
.Attachments.Add strFileName 'this one doesn't
.Display
'.Send
End With
On Error GoTo 0

Set appOutlook = Nothing
Set objEmail = Nothing


GoTo NextEmailItem
On Error GoTo 0
NextEmailItem:
Next

application.ScreenUpdating = True
application.EnableEvents = True
End Sub



Function swapVariables(inputString As String, Optional replaceFileName As
String = "")

inputString = Replace(inputString, "%time%", Format(Now(), "hh-mm t"))
inputString = Replace(inputString, "%date%", Format(Now(), "mm-dd-yyyy"))
inputString = Replace(inputString, "%email%", strEmail)

If Len(replaceFileName) > 0 Then
inputString = Replace(inputString, "%filename%", replaceFileName)
strFileName = inputString
Else
inputString = Replace(inputString, "%filename%", strFileName)
End If
swapVariables = inputString
End Function

 

[Ron de Bruin]

Hi PTweety

Not so easy to give a answer

Start with the examples on my site and psot back if you have a problem with one of the examples
http://www.rondebruin.nl/sendmail.htm

 

[Ryan H]

I made some edits to the code you posted. I added a message box that will
ask the user if you want to attach the activeworkbook. Plus I added a
reference to the "E-mail" worksheet. I got this to work just fine. But I
have some questions.

The ActiveWorkbook which contains this code is the workbook that contains
the worksheet "E-mail", right?

Also, make sure that the code that stores the file name in Col. C of the
ActiveWorkbook, stores the .FullName. The .FullName property should contain
the full path and file name. For example, "C:\Documents and
Settings\Desktop\Book1.xlsm"

If that doesn't fix the issue let me know. Please specify the error
description and which line the error occurs in. Hope this helps! If so, let
me know, click "YES" below.

Put this code in a Standard Module:

Option Explicit

Dim strEmail As String
Dim strFileName As String

Sub EmailList()

Dim rngEmailList As Range
Dim rngEmailItem As Range

Application.ScreenUpdating = False
Application.EnableEvents = False

Set rngEmailList = Sheets("E-Mail").Range("A13:A" &
Sheets("E-Mail").Cells(Rows.Count, "A").End(xlUp).Row)

For Each rngEmailItem In rngEmailList
If rngEmailItem(, 2) = "Y" Then
strEmail = rngEmailItem(, 1)
strFileName = rngEmailItem(, 3)

Dim appOutlook As Object
Dim objEmail As Object

Set appOutlook = CreateObject("Outlook.Application")
appOutlook.Session.Logon
Set objEmail = appOutlook.CreateItem(0)

With objEmail
.To = strEmail
.Subject = swapVariables(Sheets("E-Mail").Range("B5"))
.Body = swapVariables(Sheets("E-Mail").Range("B6"))

' ask if you want to attach active workbook
If MsgBox("Do you want to attach " & ActiveWorkbook.FullName
& "?", vbYesNo + vbQuestion) = vbYes Then
.Attachments.Add ActiveWorkbook.FullName
End If

.Attachments.Add (swapVariables(Sheets("E-Mail").Range("B7")))
.Attachments.Add swapVariables(strFileName)
.Attachments.Add strFileName

.Display
.Send
End With

Set appOutlook = Nothing
Set objEmail = Nothing
End If
Next

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

 

[Barb Reinhardt]

What do you have defined for strfilename. Is it the full file path or is it
a file name and the file isn't in your default directory. You may need to
concatenate the folder path to the file name.

 

[pickytweety]

(e-mail address removed) Y s:\Fin\Temporary\December Report - Zone 1.xls
(e-mail address removed) Y s:\Fin\Temporary\December Report - Zone 2.xls
(e-mail address removed) Y s:\Fin\Temporary\December Report - Zone 3.xls
(e-mail address removed) Y s:\Fin\Temporary\December Report - Zone 4.xls
and so on… and so on…

Ok, I get a "path not found error". It isn't code that stores the filename
in col C-- I manually type it into the "Email" worksheet, and yes, you're
right, the Email worksheet is in the active workbook. For example, see copy
and paste of "Email" worksheet above. I've always typed the full path, but
it still says it can't find it. I've even tried it with and without quotes.
Any ideas for me?

 

[Ryan H]

Well, it sounds like Excel is telling you the problem. You most likely have
the workbooks FullNames (Path & File Name) wrong. To ensure you have the
FullName right, go into the Windows Explorer and navigate to the workbook of
interest and then cut and paste the FullName into the cell. Do this for all
your workbooks in the E-mail worksheet and see if that helps you.

 

[pickytweety]

Oh 'm gosh. I'm sheepishly admitting to typing the path wrong. I left out
an "s". Thank you so much for your help. By the way, I used to be able to
search by the posts by "PTweety" to find my posts. It's not letting me do
that now. Well actually it did bring up my old, old posts, just not anything
from 2010. I had to page down to the right date to find this post. Did
something change? Also, I thought I had checked "notify me of replies" but I
never got an email like I used to.