2

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

2 回答 2

1

这应该可以满足您的需求。

修改自我几周前在 SuperUser 上所做的一个答案，由于 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
于 2013-03-22T16:08:52.247 回答
0

尝试

Sub Select_Range_now()

  ....

  Set Sendrng = ActiveWorkbook.WorkSheets("Output").Range("B1:I" & EndOfLine)

  ....

End Sub

和

Function Find_First() As String

  ....

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

  ....

End Sub

如果您从 Excel 以外的应用程序运行这些函数，强烈建议您ActiveWorkbook使用引用您的 Excel 实例的变量 ( AppExcel.ActiveWorkbook...) 作为前缀，否则如果打开第二个 Excel 实例，您的应用程序可能会失败。

抱歉，我目前无法解决您问题的第二部分。

于 2013-03-22T15:54:49.650 回答