VBA代码复制和粘贴Excel范围到Outlook中

我需要将Excel文件的范围复制到Outlook中，然后将其作为电子邮件发送。 它需要embedded到电子邮件本身。 我发现这个代码很好用，但有一个例外：它将范围居中在Outlook的“页面”中间，我需要它左alignment。

我假设这是在HTML中完成，但我不知道这种语言。 这是我正在使用的代码：

Option Explicit Public Sub prcSendMail() Dim objOutlook As Object, objMail As Object Set objOutlook = CreateObject(Class:="Outlook.Application") Set objMail = objOutlook.CreateItem(0) With objMail .To = "[e-mail]" .Subject = "Hallo" .HTMLBody = fncRangeToHtml("Summary", "B2:G26") .Display 'zum testen ' .Send End With Set objMail = Nothing Set objOutlook = Nothing End Sub Private Function fncRangeToHtml( _ strWorksheetName As String, _ strRangeAddress As String) As String Dim objFilesytem As Object, objTextstream As Object, objShape As Shape Dim strFilename As String, strTempText As String Dim blnRangeContainsShapes As Boolean strFilename = Environ$("temp") & "\" & _ Format(Now, "dd-mm-yy_h-mm-ss") & ".htm" ThisWorkbook.PublishObjects.Add( _ SourceType:=xlSourceRange, _ Filename:=strFilename, _ Sheet:=strWorksheetName, _ Source:=strRangeAddress, _ HtmlType:=xlHtmlStatic).Publish True Set objFilesytem = CreateObject("Scripting.FileSystemObject") Set objTextstream = objFilesytem.GetFile(strFilename).OpenAsTextStream(1, -2) strTempText = objTextstream.ReadAll objTextstream.Close For Each objShape In Worksheets(strWorksheetName).Shapes If Not Intersect(objShape.TopLeftCell, Worksheets( _ strWorksheetName).Range(strRangeAddress)) Is Nothing Then blnRangeContainsShapes = True Exit For End If Next If blnRangeContainsShapes Then _ strTempText = fncConvertPictureToMail(strTempText, Worksheets(strWorksheetName)) fncRangeToHtml = strTempText Set objTextstream = Nothing Set objFilesytem = Nothing Kill strFilename End Function Public Function fncConvertPictureToMail(strTempText As String, objWorksheet As Worksheet) As String Const HTM_START = "<link rel=File-List href=" Const HTM_END = "/filelist.xml" Dim strTemp As String Dim lngPathLeft As Long lngPathLeft = InStr(1, strTempText, HTM_START) strTemp = Mid$(strTempText, lngPathLeft, InStr(lngPathLeft, strTempText, ">") - lngPathLeft) strTemp = Replace(strTemp, HTM_START & Chr$(34), "") strTemp = Replace(strTemp, HTM_END & Chr$(34), "") strTemp = strTemp & "/" strTempText = Replace(strTempText, strTemp, Environ$("temp") & "\" & strTemp) fncConvertPictureToMail = strTempText End Function 

是否有一些代码将我复制到Outlook的范围alignment？ 我有W7 x64，Excel 2013和Outlook 2013.谢谢！

Answer 1

在你的objTextstream.Close之后添加这个

 strTempText = Replace(strTempText, "align=center x:publishsource=", "align=left x:publishsource=") 

Answer 2

这对我有效

  With objMail .To = "[e-mail]" .cc = "" .Subject = "BR1 Summary for Adjustments +/- >$250" .HTMLBody = "<table width='100'><tr><td align=left>" + fncRangeToHtml("weekly adjustments report", Sheet1.UsedRange.Address) + "</td></tr></table>" & "<br>" & "<b>" & "<font size=4>" & "Adjustments +/- >$250" & "</font>" & "</b>" & fncRangeToHtml("Sheet1", Sheet2.UsedRange.Address) 

VBA喜欢引号和空格。 但是在最后一行代码中，您可以引用所有的HTML函数或将其分解。 但是一旦你完成了如粗体的使用，你必须“/function”才能结束它喜欢的信息。 ＆和+工作是一样的。