I have this code that creates a copy of my excel sheet and puts it an email in outlook. this works perfectly.
However, I run a filter with a change event once a loan officer is chosen in cell and I would like to modify my macro to strip out all the other data so the user that receives the emailed sheet does not see the other loan officers data.
I am not sure how to accomplish this, can someone help me add the needed code?
However, I run a filter with a change event once a loan officer is chosen in cell and I would like to modify my macro to strip out all the other data so the user that receives the emailed sheet does not see the other loan officers data.
I am not sure how to accomplish this, can someone help me add the needed code?
VBA Code:
Sub Mail_workbook_Outlook()
Dim wb1 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object
Set mysht = ThisWorkbook.Worksheets("Data")
Application.EnableEvents = False
If Range("B6").Value = "" Then
MsgBox "Please select a loan officer", vbCritical, "Read me"
Else
Sheets("List").Visible = False
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb1 = ActiveWorkbook
'Make a copy of the file/Open it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = Sheets("Data").Range("B6").Value & " Refi Opportunity List"
FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
'.to = ""
.CC = ""
.BCC = ""
.Subject = Sheets("Data").Range("B6").Value & " Refi Opportunity List"
'.Body = "Hello, see attached refi opportunity list"
.Attachments.Add TempFilePath & TempFileName & FileExtStr
.Display
End With
On Error GoTo 0
'Delete the file
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Worksheets("List").Visible = True
Application.EnableEvents = True
End If
End Sub