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