将数据从Excel导出到Outlook

我已经在Excel中起草了一封电子邮件,用于填充数据表中的信息。

单元格A1到A4包含“嗨,希望你做得好”和消息….等。

A5到H10有一个表格,信息和A11到A30有电子邮件内容,如“期待您的答复”。

我只想复制A1:A4和A11:A30的值,但希望A5:H10以表格forms出现。

此代码来自Ron De Bruin。

我的下面的代码以表格格式粘贴所有内容:

Sub Mail() Dim rng As Range Dim OutApp As Object Dim OutMail As Object Set rng = Nothing On Error Resume Next Set rng = ActiveSheet.Range("A1:A24").SpecialCells(xlCellTypeVisible) On Error GoTo 0 If rng Is Nothing Then MsgBox "The selection is not a range or the sheet is protected" & _ vbNewLine & "please correct and try again.", vbOKOnly Exit Sub End If With Application .EnableEvents = False .ScreenUpdating = False End With Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .Display .To = "" .CC = "" .BCC = "" .Subject = "" .HTMLBody = RangetoHTML(rng) End With On Error GoTo 0 With Application .EnableEvents = True .ScreenUpdating = True End With Set OutMail = Nothing Set OutApp = Nothing End Sub 

我其余的代码:

 Function RangetoHTML(rng As Range) Dim fso As Object Dim ts As Object Dim TempFile As String Dim TempWB As Workbook TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" rng.Copy Set TempWB = Workbooks.Add(1) With TempWB.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial xlPasteValues, , False, False .Cells(1).PasteSpecial xlPasteFormats, , False, False .Cells(1).Select Application.CutCopyMode = False On Error Resume Next .DrawingObjects.Visible = True .DrawingObjects.Delete On Error GoTo 0 End With With TempWB.PublishObjects.Add( _ SourceType:=xlSourceRange, _ Filename:=TempFile, _ Sheet:=TempWB.Sheets(1).Name, _ Source:=TempWB.Sheets(1).UsedRange.Address, _ HtmlType:=xlHtmlStatic) .Publish (True) End With Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) RangetoHTML = ts.readall ts.Close RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _ "align=left x:publishsource=") TempWB.Close savechanges:=False Kill TempFile Set ts = Nothing Set fso = Nothing Set TempWB = Nothing End Function 

使用快捷方式范围方法 []

常用方法Range("A1").Value = 123 ,快捷方式为[A1] = 123

 With OutMail .Display .To = "" .CC = "" .BCC = "" .Subject = "" .HTMLBody = [A1] & "<BR>" & _ [A2] & "<BR>" & _ [A3] & "<BR>" & _ [A4] & RangetoHTML(rng) & _ [A11] & "<BR>" & _ [A12] & "<BR>" & _ [A13] & "<BR>" & _ [A14] & "<BR>" ' And more [range] End With 

请记住,方括号是Range /括号/引号结构的替代方法,该方法返回对范围的实际引用,它可以在等号的任一侧使用。 它可以用来提供其他function它具有正常范围的所有方法和属性。

记住捷径方法永远不是最快的