如何通过电子邮件发送筛选的数据

Question

我已经检查了其他一些有此问题的问题，如果有人可以帮助我，我看不到我哪里出错了。我有一个宏Reported，可以过滤掉不需要传递的数据。然后应选择其余部分并通过电子邮件发送出去。问题是相应的数据通过电子邮件发送为空白。

Sub SendCONSULTANT()
Reported
Dim OLApp           As OUTLOOK.Application
Dim OLMail          As Object
Dim sFileName       As String
Dim name As String
Dim todaydate As String

name = Sheets("Accepting List").Range("b8").Value
todaydate = Format(CStr(Now), "DDDD D MMMM YYYY")
sFileName = "" & "Outstanding Cases " & todaydate & _
".xlsx"
Set OLApp = New OUTLOOK.Application
Set OLMail = OLApp.CreateItem(0)
Application.DisplayAlerts = False
ActiveSheet.Range("B6:n68").SpecialCells(xlCellTypeVisible).Copy
Workbooks.Add
With Range("A1")
.PasteSpecial xlPasteValuesAndNumberFormats
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteFormats
End With
ActiveWorkbook.SaveAs ThisWorkbook.Path & sFileName
OLApp.Session.Logon
With OLMail
.To = "******@*****.com"
.CC = ""
.BCC = ""
.Subject = "Outstanding CT Cases"
.Body = "Hello" & vbNewLine & vbNewLine & "Please find attached an extract of all outstanding cases that may require reporting" & vbNewLine & vbNewLine & "Kind Regards" & vbNewLine & vbNewLine
.Attachments.Add (ThisWorkbook.Path & sFileName)
.Display
.Send
End With
ActiveWorkbook.Close SaveChanges:=True
Kill ThisWorkbook.Path & sFileName
Set OLMail = Nothing
Set OLApp = Nothing
Application.DisplayAlerts = True
Reportedrestore
End Sub

如果有人能告诉我为什么可见单元格选择不起作用，我将不胜感激

Answer 1

为了确保您的更改保存到文件中，您可以尝试在磁盘上打开，观察文件内容。

方法创建一个新工作簿，一个表示新工作簿的Workbook对象将返回。因此，我建议使用此 ibject 粘贴数据并保存到磁盘。