如何在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