On 2002-03-17 21:24, RichardS wrote:
Haven't downloaded it yet. I am waiting to get approval from my systems manager. He didn't seem to keen on me loading something which circumvents Outlook security. I'll convince him yet!!
Here's the code;
Sub Send_New()
'
' Send_New Macro
' Macro recorded 5/07/2001 by Richard.Staude
'
'
Application.ScreenUpdating = False
Sheets("Sheet Index").Select
Application.DisplayAlerts = False
Dim counter As Integer
For counter = 1 To ActiveWorkbook.Sheets.Count
' Check to see if email address in cell E1 on current sheet
If Sheets(counter).[E1] <> "" Then
Workbooks.Add Template:="Workbook"
ActiveSheet.PageSetup.Orientation = xlLandscape
ActiveWorkbook.SaveAs Filename:="C:Send Budget.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Windows("Report.xls").Activate
Application.Goto Reference:="Print_Area"
Selection.Copy
Windows("Send Budget").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.Columns.AutoFit
Windows("Report.xls").Activate
Range("E1").Select
Application.CutCopyMode = False
Selection.Copy
'Copy email address to Send Budget
Windows("Send Budget").Activate
Range("A52").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
'email Send Budget to email recipient
ActiveWorkbook.SendMail Recipients:=Range("A52")
ActiveWorkbook.Close SaveChanges:=False
End If
ActiveSheet.Next.Select
Next counter
Sheets("Sheet Index").Select
Application.DisplayAlerts = True
End Sub
Thanks
Richard