1、Sub Automail()'邮件对象Dim OutlookApp As ObjectDim MailItem As Ob枣娣空郅jectDim Recipient As ObjectDim i As Integer'邮件内容变量Dim Mail_Body As StringDim Mail_To As StringDim Mail_CC As StringDim Mail_Subject As StringDim Mail_Attachment As StringDim shift As StringSet OutlookApp = CreateObject("Outlook.Application")Set MailItem = OutlookApp.CreateItem(0)ActiveWorkbook.SaveMail_To = "[email protected]"Mail_CC = "[email protected]"Mail_Subject = "Daily Report - " & Format(Date, "mm/dd")Mail_Attachment = ActiveWorkbook.Path & "\" & ActiveWorkbook.NameMail_Body = "<H2><Font Face = Times New Roman Size = 4>Hi Sir:</H2><BR>" & _ "Daily Report:" & _ ExcelToHTML() & _ "Best Regards<BR>" & _ "me" 'mail contentOn Error Resume NextWith MailItem .To = Mail_To .CC = Mail_CC .BCC = "" .Subject = Mail_Subject .attachments.Add Mail_Attachment .HTMLBody = Mail_Body .Display 'or use .sendEnd WithOn Error GoTo 0Set OutlookApp = NothingSet MailItem = NothingEnd SubFunction ExcelToHTML() '提取需要的表格转成HTML格式Application.ScreenUpdating = FalseDim WB As WorkbookDim TempWB As WorkbookDim TempFile As StringSet WB = ThisWorkbook'select necessary rangeThisWorkbook.Sheets("Sheet1").Range("A2:B3").SelectSelection.Copy'create tempWB to save selected rangeSet TempWB = Workbooks.AddTempFile = "a.htm"TempWB.ActivateTempWB.ActiveSheet.Range("A1").SelectSelection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _SkipBlanks:=False, Transpose:=FalseActiveSheet.Paste'Publish the sheet to a htm fileWith 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 ExcelToHTMLSet fso = CreateObject("Scripting.FileSystemObject")Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)ExcelToHTML = ts.ReadAllts.CloseExcelToHTML = Replace(ExcelToHTML, "align=center x:publishsource=", _ "align=left x:publishsource=")'Close TempWBTempWB.Close savechanges:=False'Delete the htm file we used in this functionKill TempFileSet ts = NothingSet fso = NothingSet TempWB = NothingApplication.ScreenUpdating = TrueEnd Function
