This little gem work perfect as a stand-alone script running from my PERSONAL Workbook. It is designed to look at a hidden "white out" value in B1 of EACH worksheet and email to the person whose address is in that cell.
As soon as I tried to attach it to a button and run it from another workbook, it errors! When it hits the .SEND part of the code it says it can't find a recipient.
Any help would be appreciated!
DT
As soon as I tried to attach it to a button and run it from another workbook, it errors! When it hits the .SEND part of the code it says it can't find a recipient.
Code:
Private Sub CommandButton2_Click()
Dim wb As Workbook, x As String
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then x = wb.Name
Next wb
Workbooks(x).Activate
'LOOPER
Dim sht As Object
For Each sht In Sheets
If sht.Name <> "Summary" And sht.Name <> "Emails" Then
sht.Activate
With sht
Dim oApp As Object
Dim oMail As Object
Dim LWorkbook As Workbook
Dim LFileName As String
'Turn off screen updating
Application.ScreenUpdating = False
'Copy the active worksheet and save to a temporary workbook
ActiveSheet.Copy
Set LWorkbook = ActiveWorkbook
'Create a temporary file in your current directory that uses the name
' of the sheet as the filename
LFileName = LWorkbook.Worksheets(1).Name
On Error Resume Next
'Delete the file if it already exists
Kill LFileName
On Error GoTo 0
'Save temporary file
LWorkbook.SaveAs Filename:=LFileName
'Create an Outlook object and new mail message
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
'Set mail attributes (uncomment lines to enter attributes)
' In this example, only the attachment is being added to the mail message
With oMail
.To = Range("B1").Value
.Subject = "RevMan Pricing WorkSheet TEST- " & LFileName
.body = "Jeff Benedek - RevMan Lead" & vbCrLf & vbCrLf & _
"Attached is the RevMan file!"
.Attachments.Add LWorkbook.FullName
.Send
End With
'Delete the temporary file and close temporary Workbook
LWorkbook.ChangeFileAccess Mode:=xlReadOnly
Kill LWorkbook.FullName
LWorkbook.Close SaveChanges:=False
'Turn back on screen updating
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End With
End If
Next sht
End Sub
Any help would be appreciated!
DT