Want code for emailing Excel files that aren't the activewrkbk-Out
 

I have an Excel file that I use as a template. In other words, I open the
file, run a macro (not the one below) and then save it with a name like
"December report - Zone 1". Then I run the macro again for Zone 2 and save
it with a name like "December report - Zone 2" and so on for many zones. In
my template file, I have a worksheet called Email. In the Email worksheet
beginning on row 13 I have a list of email addresses in column A and the
files (as decribed above) listed in column C. I want code that will build my
emails for me to send to the various people in charge of the zones. The code
below works, but will only send my activeworkbook file rather than the ones I
saved off with the various Month/Zone filenames. I put notes to the right of
the code below so you can see what I'm talking about.
--
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 line
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

Want code for emailing Excel files that aren't the activewrkbk-Out
 

This post is a repeat of an earlier 1-20-2010 post. Sorry--thought it didn't
"go through" because I couldn't view it. Not sure why it was acting strange
and not letting me view my own posts.
--
Thanks,
PTweety


"pickytweety" wrote:

I have an Excel file that I use as a template. In other words, I open the
file, run a macro (not the one below) and then save it with a name like
"December report - Zone 1". Then I run the macro again for Zone 2 and save
it with a name like "December report - Zone 2" and so on for many zones. In
my template file, I have a worksheet called Email. In the Email worksheet
beginning on row 13 I have a list of email addresses in column A and the
files (as decribed above) listed in column C. I want code that will build my
emails for me to send to the various people in charge of the zones. The code
below works, but will only send my activeworkbook file rather than the ones I
saved off with the various Month/Zone filenames. I put notes to the right of
the code below so you can see what I'm talking about.
--
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 line
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