Question

我无法获得嵌入电子邮件中的范围以便左对齐。我尝试了几件事，但嵌入式部分仍然在电子邮件中。这是我的代码，具有讽刺意味的是，在其他电子表格中运行得很好。我尝试过添加HTML标签，更改功能，但都无济于事。任何帮助，将不胜感激。这是在W7x64和Office 2010上。在此报告中，我嵌入了一个数据透视表而不是常规范围。

感谢。

Option Explicit

SalesSub Mail_RegionalRANGE()

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem


'On Error Resume Next

    Set OutApp = CreateObject("outlook.application")
    Set OutMail = OutApp.CreateItem(olMailItem)

    With OutMail
        .SentOnBehalfOfName = "SalesAnalytics@company.us"
        .Display
        .Subject = "Sales Report"
        .To = "mike.marshall@company.us"
        '.CC =
        '.BCC =
        '.Attachments.Add "\\filesrv1\department shares\Sales Report\Sales Report.xlsx"
        .HTMLBody = "<br>" _
            & "Attached is the Sales Report.  Please reach out to me with any questions." _
            & "<br><br>" _
            & "<p align=left>" & fncRangeToHtml("RegAEPctg", "B2:P67") & "<p>" _
            & .HTMLBody

        .Display
        '.Send
    End With


Set OutApp = Nothing
Set OutMail = 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

   Set objTextstream = Nothing
 Set objFilesytem = Nothing

 'Kill strFilename


 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
 strTempText = Replace(strTempText, "align=center x:publishsource=", "align=left x:publishsource=")

 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

Answer 1

我不是100％肯定，但这似乎是你的rng到html函数的原因。我有一个类似的问题，我使用的旧版本的旧版本，所以我的解决方案是一种解决方法，通过重写你正在使用的功能。

对于缺乏代表不能发表评论，所以请一定要带上它。

我建议使用此range_to_html函数，并使用工作簿打开/激活调用您的工作簿/工作表进行扩展：

Function RangetoHTML(rng As Range) ' converts a range into html for email-sendout'
  ' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
    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"

    ' Copy the range and create a workbook to receive the data.
    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

    ' Publish the sheet to an .htm file.
    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

    ' Read all data from the .htm file into the RangetoHTML subroutine.
    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=")

    ' Close TempWB.
    TempWB.Close savechanges:=False

    ' Delete the htm file.
    Kill TempFile

    Set ts = Nothing
    Set FSO = Nothing
    Set TempWB = Nothing
End Function

我已经将这个用于所有相关的范围，无论它选择了什么，它总是符合一般的电子邮件格式。资料来源：http://www.mrexcel.com/forum/excel-questions/485720-ron-de-bruin-rangetohtml.html

由于您直接从文件中读取，因此html可能包含代码的allign命令。这里的这个复制和重新发布应该绕过这个问题。我也不确定此代码如何处理形状，因此它可能不适用于具有形状的范围。

此外，如果我误解了问题并且问题是单元格中的文本是左对齐的，那么就更容易识别和修复。

左对齐电子邮件中的嵌入范围

1 个答案: