运行时错误'1004':Range类的PasteSpecial方法失败

时间:2018-02-13 10:40:26

标签: excel vba outlook

我正在使用VBA for outlook,我的代码如下:

 Function RangetoHTML(rn As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    rn.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         FileName:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).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=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

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

错误发生在.Cells(1).PasteSpecial xlPasteValues ,, False,False 在RangetoHTML函数中。

我之前在excel上使用过这个开源函数,但它似乎在outlook中不起作用。我的功能打开了outlook和复制并粘贴了一些东西。我的目的是从excel中的某个地区发送自动电子邮件复制和粘贴。

有人对此有任何意见吗?

谢谢!

1 个答案:

答案 0 :(得分:0)

Outlook不会保留Excel的枚举数(例如xlPasteValues),但VBA可能会使用其数值。因此,尝试这样的事情:

({item}) => {
  if (item.isAdd) {
    // renderAdd
  } else {
    // renderContent
  }
}

有两种方法可以查看Option Explicit Sub TestMe() Dim tempWB As Workbook Set tempWB = Workbooks.Add(1) Dim rn As Range Set rn = Worksheets(1).Range("A1:B10") rn.Copy With tempWB.Worksheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial Paste:=-4163 End With End Sub 等于什么,就像它是一个枚举器一样,在Excel中使用而Outlook没有它:

  • 选项1 - 在即时窗口中写下xlPasteValues,然后按 Enter

  • 选项2 - 在VBA编辑器中的任何位置写入?xlPasteValues,选择它并按 Shift + F2 。然后读一下这样的帮助:

enter image description here