Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Macro to email to address in cell reference
Hi! I'm attempting to use Ron's code to email worksheets from excel. I've
always used this in the past to email to a particular address with much success (thanks Ron). Now I need it to email based on the address that is entered into a cell reference, but for whatever reason it does not work. The new workbook is created and all tabs are there and then it just stops (no error message, just stops working). Please take a look at the code and tell me if there is something I'm missing... Sub Mail_ActiveSheet_totm() Dim sh As Worksheet Dim wb1 As Workbook Dim wb2 As Workbook Dim ws As Worksheet Dim strdate As String strdate = Format(Now, "yymmdd") Application.ScreenUpdating = False Set wb1 = ThisWorkbook For Each ws In wb1.Worksheets ws.Unprotect _ Password:="password" Next ws wb1.Sheets(Array("SR", "SV", "CLPBTAV", "FVDV", "PR", "TR", "IMC")).Copy Set wb2 = ActiveWorkbook For Each sh In wb2.Worksheets wb1.Sheets(sh.Name).Cells.Copy wb2.Sheets(sh.Name).Cells(1) Next sh With wb2 ..SaveAs "C:\" & wb2.Sheets(1).Range("R2").Value & ".xls" ..SendMail wb2.Sheets(1).Range("p9").Value, wb2.Sheets(1).Range("R1").Value ..ChangeFileAccess xlReadOnly Kill .FullName ..Close False End With Application.ScreenUpdating = True For Each ws In wb1.Worksheets ws.Protect DrawingObjects:=True, _ Contents:=True, Scenarios:=True, _ Password:="password" Next ws Set wb1 = Nothing Set ws = Nothing End Sub |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
Macro to email to address in cell reference
I notice you are susing Sheets(1) in yoru code... Very rarely is that a good
idea. the sheet that is in the first position is not always what you might think it is. Just to debug what you are doing try adding a message box or such to confirm that the values being returned are correct... Sub Mail_ActiveSheet_totm() Dim sh As Worksheet Dim wb1 As Workbook Dim wb2 As Workbook Dim ws As Worksheet Dim strdate As String strdate = Format(Now, "yymmdd") Application.ScreenUpdating = False Set wb1 = ThisWorkbook For Each ws In wb1.Worksheets ws.Unprotect _ Password:="password" Next ws wb1.Sheets(Array("SR", "SV", "CLPBTAV", "FVDV", "PR", "TR", "IMC")).Copy Set wb2 = ActiveWorkbook For Each sh In wb2.Worksheets wb1.Sheets(sh.Name).Cells.Copy wb2.Sheets(sh.Name).Cells(1) Next sh With wb2 ..SaveAs "C:\" & wb2.Sheets(1).Range("R2").Value & ".xls" msgbox wb2.Sheets(1).Range("p9").Value msgbox wb2.Sheets(1).Range("R1").Value ..SendMail wb2.Sheets(1).Range("p9").Value, wb2.Sheets(1).Range("R1").Value ..ChangeFileAccess xlReadOnly Kill .FullName ..Close False End With Application.ScreenUpdating = True For Each ws In wb1.Worksheets ws.Protect DrawingObjects:=True, _ Contents:=True, Scenarios:=True, _ Password:="password" Next ws Set wb1 = Nothing Set ws = Nothing End Sub -- HTH... Jim Thomlinson "hnyb1" wrote: Hi! I'm attempting to use Ron's code to email worksheets from excel. I've always used this in the past to email to a particular address with much success (thanks Ron). Now I need it to email based on the address that is entered into a cell reference, but for whatever reason it does not work. The new workbook is created and all tabs are there and then it just stops (no error message, just stops working). Please take a look at the code and tell me if there is something I'm missing... Sub Mail_ActiveSheet_totm() Dim sh As Worksheet Dim wb1 As Workbook Dim wb2 As Workbook Dim ws As Worksheet Dim strdate As String strdate = Format(Now, "yymmdd") Application.ScreenUpdating = False Set wb1 = ThisWorkbook For Each ws In wb1.Worksheets ws.Unprotect _ Password:="password" Next ws wb1.Sheets(Array("SR", "SV", "CLPBTAV", "FVDV", "PR", "TR", "IMC")).Copy Set wb2 = ActiveWorkbook For Each sh In wb2.Worksheets wb1.Sheets(sh.Name).Cells.Copy wb2.Sheets(sh.Name).Cells(1) Next sh With wb2 .SaveAs "C:\" & wb2.Sheets(1).Range("R2").Value & ".xls" .SendMail wb2.Sheets(1).Range("p9").Value, wb2.Sheets(1).Range("R1").Value .ChangeFileAccess xlReadOnly Kill .FullName .Close False End With Application.ScreenUpdating = True For Each ws In wb1.Worksheets ws.Protect DrawingObjects:=True, _ Contents:=True, Scenarios:=True, _ Password:="password" Next ws Set wb1 = Nothing Set ws = Nothing End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How can I create a macro for my email address? | Excel Discussion (Misc queries) | |||
format cell content as hyperlinked email address | Excel Discussion (Misc queries) | |||
find email address in a cell | Excel Worksheet Functions | |||
How do I enter an email address w/in a cell & it not be automatic | Excel Discussion (Misc queries) | |||
How to format a cell as email address | Excel Discussion (Misc queries) |