Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 57
Default Code for emailing Excel workbooks will only attach activeworkbook

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


  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,123
Default Code for emailing Excel workbooks will only attach activeworkbook

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

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"pickytweety" wrote in message ...
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


  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 489
Default Code for emailing Excel workbooks will only attach activeworkbook

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
--
Cheers,
Ryan


"pickytweety" wrote:

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


  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,355
Default Code for emailing Excel workbooks will only attach activeworkbook

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.
--
HTH,

Barb Reinhardt



"pickytweety" wrote:

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


  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 57
Default Code for emailing Excel workbooks will only attach activeworkb

Y s:\Fin\Temporary\December Report - Zone 1.xls
Y s:\Fin\Temporary\December Report - Zone 2.xls
Y s:\Fin\Temporary\December Report - Zone 3.xls
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?
--
Thanks,
PTweety


"Ryan H" wrote:

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
--
Cheers,
Ryan


"pickytweety" wrote:

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




  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 489
Default Code for emailing Excel workbooks will only attach activeworkb

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.

--
Cheers,
Ryan


"pickytweety" wrote:

Y s:\Fin\Temporary\December Report - Zone 1.xls
Y s:\Fin\Temporary\December Report - Zone 2.xls
Y s:\Fin\Temporary\December Report - Zone 3.xls
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?
--
Thanks,
PTweety


"Ryan H" wrote:

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
--
Cheers,
Ryan


"pickytweety" wrote:

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


  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 57
Default Code for emailing Excel workbooks will only attach activeworkb

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.
--
Thanks,
PTweety


"Ryan H" wrote:

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.

--
Cheers,
Ryan


"pickytweety" wrote:

Y s:\Fin\Temporary\December Report - Zone 1.xls
Y s:\Fin\Temporary\December Report - Zone 2.xls
Y s:\Fin\Temporary\December Report - Zone 3.xls
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?
--
Thanks,
PTweety


"Ryan H" wrote:

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
--
Cheers,
Ryan


"pickytweety" wrote:

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


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
emailing workbooks Jerry Excel Worksheet Functions 1 September 21st 06 05:48 PM
Attach all Open Workbooks to email as separate files? nbaj2k[_25_] Excel Programming 3 August 3rd 06 02:25 PM
Emailing Workbooks Raman325[_13_] Excel Programming 2 August 11th 05 07:00 PM
How to attach a code module to a group of workbooks? keithb Excel Programming 2 August 9th 05 05:56 PM
emailing workbooks WIlliam Barnes Excel Programming 1 February 10th 04 08:15 PM


All times are GMT +1. The time now is 09:31 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"