代码之家 › 专栏 › 技术社区 › Waleed

将范围导出到outlook新消息正文时缺少下边框

outlook automation vba excel html

Waleed · 技术社区 · 2 年前

我正在使用一个代码从excel文件导出任何范围,并在outlook新消息的正文上插入(作为表)。
它解决了一个问题,即 bottom border is always missing 插入outlook邮件正文之后。
笔记 :如果我手动更改了表格的高度或宽度,则底部边框将正常显示。
代码发布在这里很长,所以我将显示HTML中我认为存在问题的部分。
一如既往,感谢您的帮助。

'--- Create a New Email
 
    Set objOutlookApp = New Outlook.Application
    Set objNewEmail = objOutlookApp.CreateItem(olMailItem)
 
'--- Read the HTML File data and insert into the Email Body
 
    objNewEmail.BodyFormat = olFormatHTML
    objNewEmail.Display
 
    Set objTextStream = objFileSystem.OpenTextFile(strTempHTMLFile)
 
    Strbody = "<h4> </h4>" & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <span style='font-size:11.5pt'> "
 
    objNewEmail.HTMLBody = Strbody & "<table style='Margin-Left:5pt'>" & _
                           objTextStream.ReadAll & "</Table>" & "<br>" & objNewEmail.HTMLBody

0 回复 | 直到 2 年前

FaneDuru 2 年前

我玩了表格边框,颜色,宽度和html创建了我想要的边框。但我无法重现你的问题。然后,我开始玩当要放置在邮件正文中的范围收到边框时应用的单元格边框。当我放置这样的薄的 borders,你的问题已经重现。我放置的初始代码 xl厚 边界。。。

因此,请使用下一个简单的函数在要导出的单元格范围上添加边框:

Sub PlaceBorders(rng As Range)
 Dim i As Long
     For i = 7 To 12
        With rng.Borders(i)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThick 'if here you will use xlThin, only in this case the problem you describe appears...
        End With
        Next i
    End Sub

不要问我为什么会这样。。。。

Waleed 2 年前

我找到了这个解决方案:

我在函数中添加了:

RangetoHTML = Replace(RangetoHTML, "table border=0 cellpadding=0 cellspacing=0", _
                      "table border=0 cellpadding=1 cellspacing=1")

行之后:

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

这样一来,巴顿边界就存在了。这是我的正确功能:

Function RangetoHTML(rngM As Range)
    Dim obj As Object
    Dim txtstr As Object
    Dim File As String
    Dim WB As Workbook
    File = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    
    rngM.Copy
    Set WB = Workbooks.Add(1)
    
    With WB.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 WB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=File, _
         Sheet:=WB.Sheets(1).Name, _
         Source:=WB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    Set obj = CreateObject("Scripting.FileSystemObject")
    Set txtstr = obj.GetFile(File).OpenAsTextStream(1, -2)
   
    RangetoHTML = txtstr.ReadAll
    txtstr.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
    
    RangetoHTML = Replace(RangetoHTML, "table border=0 cellpadding=0 cellspacing=0", _
                          "table border=0 cellpadding=1 cellspacing=1")
                          
         
    WB.Close savechanges:=False
    Kill File
    Set txtstr = Nothing
    Set obj = Nothing
    Set WB = Nothing
End Function