2

固定範囲を選択してメールの準備をする簡単な関数があります。これは機能しますが、関数を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 の 2 番目のインスタンスが開いている場合にアプリケーションが失敗する可能性があります。

申し訳ありませんが、現在、問題の 2 番目の部分に対処することはできません。

于 2013-03-22T15:54:49.650 に答える