Excel Simpe VBA sub：函数启动时出错，但不是之后

我有一个简单的功能，选择一个固定的范围，并准备电子邮件，这是工作。。。但只有在第二次运行该函数之后。问题发生在我打开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：

电子邮件：您可以将整个工作簿作为电子邮件的附件发送，也可以将当前工作表作为电子邮件正文发送。

• 将整个工作簿作为附件发送
• 将当前工作表作为消息正文发送

再次单击该按钮将不会再次提示，脚本将立即工作。我猜当第一次运行时，它似乎在处理这个对话框或其他方面有问题

如果有人需要知道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

试一试

及

如果您是从Excel以外的应用程序运行这些函数，强烈建议您在

ActiveWorkbook

前面加上引用Excel实例的变量（

AppExcel.ActiveWorkbook…

），否则，如果Excel的第二个实例打开，应用程序可能会失败

---

很抱歉，我现在无法解决您问题的第二部分。

这应该满足您的要求

根据答案修改，添加了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

子PublishObjectFromFilteredRange（）
'将自动筛选应用于工作表的示例
'并将范围变量=设置为自动筛选单元格/可见单元格
将ws设置为工作表
作为发布对象的Dim pObj
暗淡的阴影如射程
Dim OutApp作为对象
将outmail设置为对象的邮件项
设置ws=图纸（“图纸1”）
设置sndRange=ActiveWorkbook.Sheets（1.Range）（“D7:G10”）'我不明白为什么首先需要选择它。你应该尽量避免选择。如果你真的需要激活而不是选择？如何使用
工作表（“输出”）。激活
？（你也应该避免激活：）我认为没有必要
.Parent。选择
，我几乎100%肯定下一行
.Select
是多余的。如果删除或注释掉这两行会发生什么情况？当使用“邮件收件人”工具时，我想选择用于电子邮件的特定单元格范围。您的方法会更好吗？@XtremeHavoc不确定您要问的是谁，但在您的示例中，您在电子邮件中包含了整个工作表，而不仅仅是选定的范围。@XtremeHavoc能否将“查找”放在第一个函数中
Function Find_First() As String

  ....

  With ActiveWorkbook.Sheets("Output").Range("A:I")

  ....

End Sub

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