countryfan_nt
Well-known Member
- Joined
- May 19, 2004
- Messages
- 750
Dear All I am trying to have a macro that would take a range in excel and send it via outlook but it is not working can some one help me figure why?
Thank u
Sub NONDIV()
Selection.AutoFilter Field:=1, Criteria1:="NON DIV"
Range("D4:D5").Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Report").Select
Range("D6").Select
ActiveSheet.Paste
Range("D6").Select
Sheets("SECURITY SWEEP CIBG-Central").Select
Range("D6").Select
Application.CutCopyMode = False
With ActiveCell.Characters(Start:=1, Length:=20).Font
.Name = "Times New Roman CE"
.FontStyle = "Bold"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("D4:D5").Select
Selection.AutoFilter Field:=1
Sheets("Report").Select
Sheets("Report").Copy
Columns("A:A").Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Const fileName As String = "c:\SECURITY SWEEP.xls"
Dim app As Outlook.Application
Dim ns As Outlook.NameSpace
Dim folder As Outlook.MAPIFolder
Dim Item As Outlook.MailItem
'f.DeleteFile fileName, True
'Kill fileName
'Workbooks(2).SaveAs fileName, , , , , , , 1
Set ns = Outlook.Application.GetNamespace("MAPI")
Set folder = ns.GetDefaultFolder(olFolderInbox)
Set Item = folder.Items.Add("IPM.Message")
Item.To = Recipient
Item.CC = CC
Item.Subject = "SECURITY SWEEP REPORT (Central) " & " - As of " & Date
Item.Body = "Please find the attached subject report." & vbCr & "" & vbCr & "Regards," & vbCr & "NAWAF" & vbCr & "Ext. 9999 " & vbCr & " " & vbCr & " "
Item.Attachments.Add fileName, , , "XXXX"
' Just replace your fav. XXXX with the file name
Item.Display
ActiveWorkbook.Close SaveChanges:=False
End Sub
Thank u
Sub NONDIV()
Selection.AutoFilter Field:=1, Criteria1:="NON DIV"
Range("D4:D5").Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Report").Select
Range("D6").Select
ActiveSheet.Paste
Range("D6").Select
Sheets("SECURITY SWEEP CIBG-Central").Select
Range("D6").Select
Application.CutCopyMode = False
With ActiveCell.Characters(Start:=1, Length:=20).Font
.Name = "Times New Roman CE"
.FontStyle = "Bold"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("D4:D5").Select
Selection.AutoFilter Field:=1
Sheets("Report").Select
Sheets("Report").Copy
Columns("A:A").Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Const fileName As String = "c:\SECURITY SWEEP.xls"
Dim app As Outlook.Application
Dim ns As Outlook.NameSpace
Dim folder As Outlook.MAPIFolder
Dim Item As Outlook.MailItem
'f.DeleteFile fileName, True
'Kill fileName
'Workbooks(2).SaveAs fileName, , , , , , , 1
Set ns = Outlook.Application.GetNamespace("MAPI")
Set folder = ns.GetDefaultFolder(olFolderInbox)
Set Item = folder.Items.Add("IPM.Message")
Item.To = Recipient
Item.CC = CC
Item.Subject = "SECURITY SWEEP REPORT (Central) " & " - As of " & Date
Item.Body = "Please find the attached subject report." & vbCr & "" & vbCr & "Regards," & vbCr & "NAWAF" & vbCr & "Ext. 9999 " & vbCr & " " & vbCr & " "
Item.Attachments.Add fileName, , , "XXXX"
' Just replace your fav. XXXX with the file name
Item.Display
ActiveWorkbook.Close SaveChanges:=False
End Sub