首页 文章

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

提问于
浏览
-1

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

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

例如,在一张纸上我粘贴了第一行约500个字符的文本 . 在下一行,我粘贴了一张5 * 10的 table . 将数据复制到html文件时,它只计算10列并复制屏幕截图中为黄色的数据 .

如何将所有数据从Excel复制到html文件 .

如果我使用Sheet.UsedRange然后在列的基础上它复制数据 .

enter image description here

码:

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 回答

  • 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 ....
    

相关问题