Simpe VBA子：功能启动时出现错误，但不在之后 [英] Simpe VBA sub: Error on start of function, but not after
问题描述
我有一个简单的功能来选择一个固定的范围和准备电子邮件，这是工作...但只有在第二次运行功能之后。问题发生在我打开Excel电子表格后，我会结束脚本并再次运行，然后它就像一个魅力。
你的帮助很多感谢，非常想了解错误发生的原因。
错误：运行时错误1004：选择工作表类的方法失败。 / p>
在调试中，然后从脚本中突出显示.Parent.Select。
Sub Select_Range_now（）
Dim Sendrng As Range
Dim EndOfLine As Integer
EndOfLine = Find_First（） - 1
Set Sendrng = Worksheets （输出）范围（B1：I& EndOfLine）
ActiveWorkbook.EnvelopeVisible = True
With Sendrng
.Parent.Select
。选择
带.Parent.MailEnvelope
带.Item
.SentOnBehalfOfName =groupemail@someemail.com
.To =someothergroupemail @ someemail。 C om
.CC =
.Subject =报告
结束
结束
结束
结束Sub
编辑：新发现：
当点击邮件收件人选项时，我收到这个msgbox： msgbox对话框
电子邮件：您可以将整个工作簿作为附件发送到电子邮件，或者将当前工作表作为电子邮件的正文发送。
- 发送整个工作簿作为附件
- 将当前工作表作为邮件正文发送
再次点击该按钮不会再次提示，脚本也可以立即工作。我猜测当运行第一次似乎有麻烦处理这个对话框，或者什么！
如果有人需要知道Find_First（）函数，它用于查找文本ENDOFLINE，所以我可以计算我的选择范围：
函数Find_First（）As String
Dim FindString As String
Dim Rng As Range
FindString =ENDOFLINE
带表格（输出）。范围（A：I）
设置Rng = .Find（What：= FindString，_
After：=。Cells（.Cells.Count），_
LookIn：= xlValues，_
LookAt：= xlWhole，_
SearchOrder：= xlByRows，_
SearchDirection：= xlNext，_
MatchCase：= False）
如果没有Rng没有，然后
'Application.Goto Rng，True
'MsgBox行号：& R $ R $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ / code>
这应该做你想要的。
从答案修改我在几个星期前在SuperUser上完成了，由于Ron de Bruin的额外费用，其中一些代码在 RangeToHTML（ ）
Sub PublishObjectFromFilteredRange（）
'将自动过滤器应用到表
'和设置范围变量=到自动过滤的单元格/可见单元格
Dim ws As Worksheet
Dim pObj As PublishObject
Dim sndRange As Range
Dim OutApp As Object
Dim outmail As Object'mail item
设置ws = Sheets（Sheet1）
设置sndRange = ActiveWorkbook.Sheets（1）.Range（D7：G10） '< ---修改此行以使用您的sendRange
'创建&发布PublishObject
'将文件名更改为适合您的位置...
设置pObj = ActiveWorkbook.PublishObjects.Add（_
SourceType：= xlSourceRange，_
文件名：=C：\Users\david_zemens\Desktop\publish.htm，_
表：=Sheet1，_
来源：= sndRange.Address，_
HtmlType：= xlHtmlStatic）
pObj.Publish True
'创建Outlook的一个实例来发送电子邮件：
设置OutApp = CreateObject（Outlook.Application ）
设置outmail = OutApp.CreateItem（0）
使用outmail
.SentOnBehalfOfName =我！
.To =email @ address
.CC =someoneelse @ address
.Subject =Report
.HTMLBody = RangetoHTML（sndRange）
。发送'或使用。显示以显示消息。
结束
OutApp.Quit
End Sub
函数RangetoHTML（rng As Range）
'更改为Ron de Bruin 2006年10月28日
'在Office 2000-2010中工作
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ $（temp）& /&格式（现在，dd-mm-yy h-mm-ss）& .htm
'复制范围并创建一个新的工作簿以过去数据
rng.Copy
设置TempWB = Workbooks.Add（1）
使用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 。删除
错误GoTo 0
结束
'将工作表发布到htm文件
使用TempWB.PublishObjects.Add（_
SourceType： = xlSourceRange，_
文件名：= TempFile，_
表：= TempWB.Sheets（1）.Name，_
源：= TempWB.Sheets（1）.UsedRange.Address，_
HtmlType：= xlHtmlStatic）
.Publish（True）
结束
'将htm文件中的所有数据读入RangetoHTML
设置fso = CreateObject （Scripting.FileSystemObject）
设置ts = fso.Ge tFile（TempFile）.OpenAsTextStream（1，-2）
RangetoHTML = ts.readall
ts.Close
RangetoHTML =替换（RangetoHTML，align = center x：publishsource =，_
align = left x：publishsource =）
'关闭TempWB
TempWB.Close savechanges：= False
'删除我们使用的htm文件在这个函数
Kill TempFile
设置ts =没有
设置fso =没有
设置TempWB =没有
结束函数
I have a simple function to select a fixed range and prepare for email, which works... but only after running the function the second time. The issue happens right after I open the Excel spreadsheet, I would then "end" the script and run it again, then it works like a charm.
Your help is much appreciated, would very much like to understand why the error is happening.
Error: Runtime Error 1004: Select method of Worksheet class failed.
On debug, the line ".Parent.Select" is then highlighted from the script below.
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
EDIT: New find:
When clicking on "Mail Recipient" option, I get this msgbox: msgbox dialog
Email: You can send the entire workbook as an attachment to an email message or send the current sheet as the body of an email message.
- Send the entire workbook as an attachment
- Send the current sheet as the message body
Clicking on that button again will not prompt this again and the script works right away. I'm guessing that when running the first time it seems to have trouble handling this dialog, or something!
In case anyone needs to know what the Find_First() function, it's used to find the text ENDOFLINE so I can calculate my selection range:
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
This should do what you're looking for.
Modified from an answer I did over at SuperUser a few weeks ago, with add'l credit due to Ron de Bruin, some of whose code is adapted in the RangeToHTML() function below.
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
这篇关于Simpe VBA子：功能启动时出现错误，但不在之后的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
