[英]Run-time error '1004': PasteSpecial method of Range class failed
I'm using VBA for outlook, my code is as follows: 我将VBA用于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
The error is at .Cells(1).PasteSpecial xlPasteValues, , False, False within the RangetoHTML function. 错误发生在RangetoHTML函数中的.Cells(1).PasteSpecial xlPasteValues,False,False。
I've used this open source function before on vba on excel before, but it seems to not work in outlook. 之前,我曾在vba上的excel上使用过此开源功能,但在Outlook中似乎不起作用。 My function opens excel from outlook and copy and pastes a few things.
我的函数从Outlook打开Excel,然后复制并粘贴一些内容。 My intention is to send automated emails copy and pasting from a region in excel.
我的意图是从excel中的某个区域发送自动电子邮件副本和粘贴。
Does anyone have any input on this? 有人对此有任何意见吗?
Thanks! 谢谢!
Outlook does not keep the enumerators of Excel (eg xlPasteValues), but VBA may work with their number values. Outlook不保留Excel的枚举数(例如xlPasteValues),但是VBA可以使用其数字值。 Thus, try something like this:
因此,尝试这样的事情:
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
There are two ways to see what xlPasteValues
is equal to, as far as it is an enumerator, used in Excel and Outlook does not have it: 有两种方法可以查看
xlPasteValues
等于什么,就它是枚举器而言,在Excel中使用,而Outlook没有它:
Option 1 - write ?xlPasteValues
in the immediate window and press Enter . 选项1-在立即窗口中输入
?xlPasteValues
,然后按Enter键 。
Option 2 - Write xlPasteValues
anywhere within the VBA editor, select it and press Shift + F2 . 选项2-在VBA编辑器中的任意位置编写
xlPasteValues
,选择它并按Shift + F2 。 Then read in the helper something like this: 然后在帮助器中读取如下内容:
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.