我有一个简单的功能来选择一个固定范围并准备电子邮件,它可以工作......但只有在第二次运行该功能之后。这个问题在我打开 Excel 电子表格后立即发生,然后我会“结束”脚本并再次运行它,然后它就像一个魅力一样工作。
非常感谢您的帮助,非常想了解错误发生的原因。
错误:运行时错误 1004:工作表类的选择方法失败。
在调试时,“.Parent.Select”行会从下面的脚本中突出显示。
Sub Select_Range_now()
Dim Sendrng As Range
Dim EndOfLine As Integer
EndOfLine = Find_First() - 1
Set Sendrng = Worksheets("Output").Range("B1:I" & EndOfLine)
ActiveWorkbook.EnvelopeVisible = True
With Sendrng
.Parent.Select
.Select
With .Parent.MailEnvelope
With .Item
.SentOnBehalfOfName = "groupemail@someemail.com"
.To = "someothergroupemail@someemail.com"
.CC = ""
.Subject = "Report"
End With
End With
End With
End Sub
编辑:新发现:
当点击“邮件收件人”选项时,我得到这个消息框:msgbox dialog
电子邮件:您可以将整个工作簿作为电子邮件的附件发送,也可以将当前工作表作为电子邮件的正文发送。
再次单击该按钮将不会再次提示,并且脚本会立即运行。我猜在第一次运行时似乎无法处理这个对话框,或者什么!
如果有人需要知道 Find_First() 函数是什么,它用于查找文本 ENDOFLINE 以便我可以计算我的选择范围:
Function Find_First() As String
Dim FindString As String
Dim Rng As Range
FindString = "ENDOFLINE"
With Sheets("Output").Range("A:I")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
'Application.Goto Rng, True
'MsgBox "row number: " & Rng.Row
Find_First = Rng.Row
Else
'MsgBox "Nothing found"
End If
End With
End Function
最佳答案
这应该可以满足您的需求。
修改自答案I did over at SuperUser a few weeks ago , 归功于 Ron de Bruin,其中一些代码在 RangeToHTML()
中被改编下面的功能。
Sub PublishObjectFromFilteredRange()
'An example of applying autofilter to sheet
' and setting range variable = to the autofiltered cells/visible cells
Dim ws As Worksheet
Dim pObj As PublishObject
Dim sndRange As Range
Dim OutApp As Object
Dim outmail As Object 'mail item
Set ws = Sheets("Sheet1")
Set sndRange = ActiveWorkbook.Sheets(1).Range("D7:G10") '<--- Modify this line to use your sendRange
'Create & publish the PublishObject
' Change the Filename to a location that works for you...
Set pObj = ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:="C:\Users\david_zemens\Desktop\publish.htm", _
Sheet:="Sheet1", _
Source:=sndRange.Address, _
HtmlType:=xlHtmlStatic)
pObj.Publish True
'Create an instance of Outlook to send the email:
Set OutApp = CreateObject("Outlook.Application")
Set outmail = OutApp.CreateItem(0)
With outmail
.SentOnBehalfOfName = "Me!"
.To = "email@address"
.CC = "someoneelse@address"
.Subject = "Report"
.HTMLBody = RangetoHTML(sndRange)
.Send 'Or use .Display to show the message.
End With
OutApp.Quit
End Sub
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
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
rng.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
关于excel - Simpe VBA sub : Error on start of function, 但不是之后,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/15572686/