cmonthetic
IS-IT--Management
Hi,
Using Excel 97.
I have several form and 1 of the functions I have included is the ability to email a specific worksheet to soemone. This involves copying and pasting the required sheet to a new workbook and then sending the new workbook by email.
All of this works perfectly
The problem I have is that when the user click on the email button it works, but if they then click the button again it returns an Error '9'.
The automatic creation of the workbook to paste the selected sheet into seems to be causing the problem as it is always looking for 'Book1' but I think that with each press of the email button the workbooks.add function is incrementing the 'book' by 1
Any ideas on how to get the workbooks.add function to always use 'Book1' as its name.
Code is posted below:
Private Sub EMail_Click()
Application.ActiveWorkbook.Worksheets("Printout").Activate
Workbooks.Add
Windows("GPCTransLog.xls").Activate
ActiveWindow.WindowState = xlNormal
Range("A1:L200").Select
Selection.Copy
Windows("book1").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
Application.CutCopyMode = False
Windows("GPCTransLog.xls").Activate
ActiveWindow.WindowState = xlNormal
Range("A1:L200").Select
Selection.Copy
Windows("book1").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
Application.CutCopyMode = False
Columns("A:A").ColumnWidth = 5
Columns("B:B").ColumnWidth = 9
Columns("C:C").ColumnWidth = 9
Columns("D
").ColumnWidth = 25
Columns("E:E").ColumnWidth = 12
Columns("F:F").ColumnWidth = 13
Columns("G:G").ColumnWidth = 10
Columns("H:H").ColumnWidth = 10
Columns("I:I").ColumnWidth = 9
Columns("J:J").ColumnWidth = 10
Columns("K:K").ColumnWidth = 7
Columns("L:L").ColumnWidth = 18
Cells.Find(What:="Cardholder Signature", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False).Activate
ActiveCell.RowHeight = 26.25
Range("a1").Select
ChDir "H:\"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:="H:\GPCPrintout.xls", FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close
Range("A170").Select
ActiveWindow.ScrollRow = 1
Range("A1:B1").Select
Application.DisplayAlerts = True
(LastName).Value & ", " & ActiveWorkbook.Names(FirstName).Value & " " & ActiveWorkbook.Names(GroupName).Value
SendTo = "email@company.com"
Ebody = "GPC Log"
NewFileName = "H:\GPCPrintout.xls"
Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)
With Itm
.Subject = ESubject
.To = SendTo
.Body = Ebody
.Attachments.Add ("H:\GPCPrintout.xls")
.Display
.send
End With
Set App = Nothing
Set Itm = Nothing
End Sub
TIA
Using Excel 97.
I have several form and 1 of the functions I have included is the ability to email a specific worksheet to soemone. This involves copying and pasting the required sheet to a new workbook and then sending the new workbook by email.
All of this works perfectly
The problem I have is that when the user click on the email button it works, but if they then click the button again it returns an Error '9'.
The automatic creation of the workbook to paste the selected sheet into seems to be causing the problem as it is always looking for 'Book1' but I think that with each press of the email button the workbooks.add function is incrementing the 'book' by 1
Any ideas on how to get the workbooks.add function to always use 'Book1' as its name.
Code is posted below:
Private Sub EMail_Click()
Application.ActiveWorkbook.Worksheets("Printout").Activate
Workbooks.Add
Windows("GPCTransLog.xls").Activate
ActiveWindow.WindowState = xlNormal
Range("A1:L200").Select
Selection.Copy
Windows("book1").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
Application.CutCopyMode = False
Windows("GPCTransLog.xls").Activate
ActiveWindow.WindowState = xlNormal
Range("A1:L200").Select
Selection.Copy
Windows("book1").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
Application.CutCopyMode = False
Columns("A:A").ColumnWidth = 5
Columns("B:B").ColumnWidth = 9
Columns("C:C").ColumnWidth = 9
Columns("D
Columns("E:E").ColumnWidth = 12
Columns("F:F").ColumnWidth = 13
Columns("G:G").ColumnWidth = 10
Columns("H:H").ColumnWidth = 10
Columns("I:I").ColumnWidth = 9
Columns("J:J").ColumnWidth = 10
Columns("K:K").ColumnWidth = 7
Columns("L:L").ColumnWidth = 18
Cells.Find(What:="Cardholder Signature", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False).Activate
ActiveCell.RowHeight = 26.25
Range("a1").Select
ChDir "H:\"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:="H:\GPCPrintout.xls", FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close
Range("A170").Select
ActiveWindow.ScrollRow = 1
Range("A1:B1").Select
Application.DisplayAlerts = True
(LastName).Value & ", " & ActiveWorkbook.Names(FirstName).Value & " " & ActiveWorkbook.Names(GroupName).Value
SendTo = "email@company.com"
Ebody = "GPC Log"
NewFileName = "H:\GPCPrintout.xls"
Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)
With Itm
.Subject = ESubject
.To = SendTo
.Body = Ebody
.Attachments.Add ("H:\GPCPrintout.xls")
.Display
.send
End With
Set App = Nothing
Set Itm = Nothing
End Sub
TIA