我从不同的Excel工作表中收集数据并将表和内容粘贴到一个工作表中,然后将其推送到html文件到Outlook .
将数据从工作表粘贴到html文件时,它正在计算数据所在的列数 .
例如,在一张纸上我粘贴了第一行约500个字符的文本 . 在下一行,我粘贴了一张5 * 10的 table . 将数据复制到html文件时,它只计算10列并复制屏幕截图中为黄色的数据 .
如何将所有数据从Excel复制到html文件 .
如果我使用Sheet.UsedRange然后在列的基础上它复制数据 .
码:
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Dim htmlContent
Dim RangetoHTML
Dim lastColumn
Dim lastRow
Dim LastCol
Dim TempFile As String
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
For Each ws In ActiveWorkbook.Worksheets
If (ws.Name "Signature" And ws.Name "URL") Then
Set rng = Nothing
Set rng = ws.UsedRange
lastRow = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
Set rng = Range(Cells(1, 1), Cells(lastRow, 20))
'Publish the sheet to a htm file
With ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=ws.Name, _
Source:=ws.UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
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=")
htmlContent = htmlContent & RangetoHTML
'You can also use a sheet name
'Set rng = Sheets("YourSheet").UsedRange
End If
Next ws
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "sagarwal4@dow.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = htmlContent
.Send 'or use .Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
1 回答
使用这样的东西: