excel导出outlook邮件
1、Sub Automail()
'邮件对象
Dim OutlookApp As Object
Dim MailItem As Object
Dim Recipient As Object
Dim i As Integer
'邮件内容变量
Dim Mail_Body As String
Dim Mail_To As String
Dim Mail_CC As String
Dim Mail_Subject As String
Dim Mail_Attachment As String
Dim shift As String
Set OutlookApp = CreateObject("Outlook.Application")
Set MailItem = OutlookApp.CreateItem(0)
ActiveWorkbook.Save
Mail_To = "aaaa@outlook.com"
Mail_CC = "bbbb@outlook.com"
Mail_Subject = "Daily Report - " & Format(Date, "mm/dd")
Mail_Attachment = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
Mail_Body = "<H2><Font Face = Times New Roman Size = 4>Hi Sir:</H2><BR>" & _
"Daily Report:" & _
ExcelToHTML() & _
"Best Regards<BR>" & _
"me"
'mail content
On Error Resume Next
With MailItem
.To = Mail_To
.CC = Mail_CC
.BCC = ""
.Subject = Mail_Subject
.attachments.Add Mail_Attachment
.HTMLBody = Mail_Body
.Display 'or use .send
End With
On Error GoTo 0
Set OutlookApp = Nothing
Set MailItem = Nothing
End Sub
Function ExcelToHTML() '提取需要的表格转成HTML格式
Application.ScreenUpdating = False
Dim WB As Workbook
Dim TempWB As Workbook
Dim TempFile As String
Set WB = ThisWorkbook
'select necessary range
ThisWorkbook.Sheets("Sheet1").Range("A2:B3").Select
Selection.Copy
'create tempWB to save selected range
Set TempWB = Workbooks.Add
TempFile = "a.htm"
TempWB.Activate
TempWB.ActiveSheet.Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.ActiveSheet.Name, _
Source:=TempWB.ActiveSheet.UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into ExcelToHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
ExcelToHTML = ts.ReadAll
ts.Close
ExcelToHTML = Replace(ExcelToHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
Application.ScreenUpdating = True
End Function
