Public Sub SendItAll()
Dim outlookApp
Dim mItem
Dim lRow As Long
On Error Resume Next
Set outlookApp = GetObject("", "Outlook.Application")
If Err.Number <> 0 Then
Set outlookApp = CreateObject("Outlook.Application", "")
End If
On Error GoTo 0
Application.ScreenUpdating = Fase
lRow = Worksheets("Data").Range("A65536").End(xlUp).Row
' Clear out any old data on Report
Sheets("Report").Select
Range("A4:AD" & lRow).ClearContents
' Sort data by region
'Sheets("Data").Select
'Range("A1").CurrentRegion.Select
'Selection.Sort Key1:=Range("A2"), Header:=xlYes
' Process each record on Distribution
Sheets("Distribution").Select
FinalRow = Range("A50").End(xlUp).Row
For i = 2 To FinalRow
Sheets("Distribution").Select
RegionToGet = Range("A" & i).Value
Recipient = Range("B" & i).Value
' Clear out any old data on Report
Sheets("Report").Select
Range("A4:AD" & lRow).ClearContents
' Get records from Data
Sheets("Data").Select
Range("A1").CurrentRegion.Select
' Turn on AutoFilter, if it is not on
If ActiveSheet.AutoFilterMode = False Then Selection.AutoFilter
' Filter the data to just this region
Selection.AutoFilter Field:=1, Criteria1:=RegionToGet
' Select only the visible cells and copy to Report
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy Destination:=Sheets("Report").Range("A4")
' Turn off the Autofilter
Selection.AutoFilter
' Copy the Report sheet to a new book and e-mail
Sheets("Report").Copy
ActiveWorkbook.SaveAs "C:\Windows\temp\book123.xls"
' Application.Dialogs(xlDialogSendMail).Show _
' arg1:=Recipient, _
' arg2:="Report - " & RegionToGet
Set mItem = outlookApp.CreateItem(olMailItem)
With mItem
.To = Recipient
.Subject = "Report - " & RegionToGet
.Body = "This is your report"
.Attachments.Add "C:\Windows\temp\book123.xls"
.Save
End With
ActiveWorkbook.Close SaveChanges:=False
Kill "C:\Windows\temp\book123.xls"
Application.ScreenUpdating = Fase
Next i
End Sub
|