Question

我从不同的Excel工作表中收集数据并将表和内容粘贴到一个工作表中，然后将其推送到html文件到Outlook。

将数据从工作表粘贴到html文件时，它正在计算数据所在的列数。

例如，在一张纸上我粘贴了第一行约500个字符的文本。在下一行我粘贴了一个5 * 10的表格。将数据复制到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

Answer 1

使用类似的东西：

Dim lastCell As Excel.Range

Set lastCell = Cells.Find(What:="*", After:=Cells(1, 1), Lookat:=xlPart, _
        LookIn:=xlFormulas, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious,  MatchCase:=False)

Range("A1", lastCell).Copy

'// Rest of code here ....

将数据从工作表复制到html文件到邮件

1 个答案: