如何在VBA中的邮件正文中设置HTML表的对齐方式

时间:2017-05-02 10:23:14

标签: excel vba excel-vba

如何在Outlook邮件Body中设置我的HTML表格的对齐方式。请找到我的下面的代码并引导相同的内容。

Sub Mailing()

    DefPath = "mypath"
    strDate = Format(Now, " dd-mm-yy")
    FileNameFolder = DefPath & "CRM-Report" & strDate & "\"


    fname = Dir(FileNameFolder & "\*.xlsx")

    Path = FileNameFolder

    Worksheets("Email").Select

    lr = Cells(Rows.Count, 1).End(xlUp).Row
    Set mail_array = Range(Cells(2, 1), Cells(lr, 2))
    mail_array.Select
    Do While fname <> ""
    fullsheet = (Path & fname)
    file_no = Split(fname, "-")

    mail_ID = Application.VLookup(CDbl(file_no(0)), mail_array, 2, 0)
    CC = Application.VLookup(CDbl(file_no(0)), mail_array, 2, 0)
    Workbooks.Open (fullsheet)


    'Call Mail_Sheet_Outlook_Body'''''''''''''''''''''''''''''''''''''''''''


    Dim rng As Range
        Dim OutApp As Object
        Dim OutMail As Object

        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With

        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        strDate = Format(Now, " dd-mmm-yyyy")
     With OutMail
        .display
        End With
            Signature = OutMail.HTMLBody

        On Error Resume Next
        With OutMail
            .To = mail_ID
            .CC = CC
            .BCC = ""
            .Subject = file_no(1) & "CRM Meeting report for the Month of "
             .HTMLBody = "<p align=""left"">" & RangetoHTML(rng) & "</p>" & "<br>" & Signature

             'I have tried the above code but its not working.

            .Attachments.Add (fullsheet)
            .display
            '.Send   'or use .Display
        End With
        On Error GoTo 0

        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With

        Set OutMail = Nothing
        Set OutApp = Nothing


    fname = Dir()
    Loop

    End Sub

使用以下功能,我将获得 RangetoHTML(rng)请指导ho设置对齐。

Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    'TempFile = ThisWorkbook.Path & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    TempFile = Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    Set x = ActiveWorkbook
    Set TempWB = x

    Set rng = Nothing
    Set rng = ActiveSheet.UsedRange

    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(2).Name, _
         Source:=TempWB.Sheets(2).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

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

0 个答案:

没有答案