0

Excelシートから電子メールを送信するマクロを書いています。マクロはいくつかのレポートを作成し、レポート用の電子メールを作成する機能を備えています。.Send 行に到達した場合を除いて、すべて正常に動作し、実行時エラー -2147467259 が発生します。これが何を意味するのかわかりませんが、助けていただければ幸いです。

関数のコードは次のとおりです。

Function Mail_Reports(ByRef wkDate2 As String, fileDate2 As String, wkNumber2 As String, thisYear2 As String)
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .
    Dim OutApp As Object
    Dim OutMail As Object
    Dim mailList As String
    Dim i As Long, lstRow As Long, p As Long, addressNum As Long, begRow As Long
    Dim proNam2 As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    'On Error Resume Next
   ' Change the mail address and subject in the macro before you run it.
    For i = 1 To 5 Step 1
        mailList = ""
        lstRow = Sheets("Data").Cells(Rows.Count, i).End(xlUp).Row
        addressNum = lstRow - 16
        begRow = lstRow - addressNum
        proNam2 = Sheets("Data").Cells(16, i)
        proNam2 = Replace(proNam2, " ", "")
        For p = 1 To addressNum Step 1
            mailList = Sheets("Data").Cells(begRow + p, i) & " ; " & mailList
        Next p
        With OutMail
            .To = mailList
            '.CC = "" remove comma and use this if you want to cc anyone, can be string or variable
            '.BCC = "" remove comma and use this if you want to cc anyone, can be string or variable
            .Subject = "Test"
            .HTMLBody = "<HTML><BODY><Font Face=Calibri(Body)><p>Hi All,</p><p2>Attached to this e-mail is the test file.<p2/><br><br><p3>Best,<p3/></font></BODY></HTML>"
            .attachments.Remove 1
            .attachments.Add "C:\Documents and Settings\test.xlsx"
            .Display
            .Send
    Next i


    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Function
4

2 に答える 2

1

ここでわかる問題の 1 つは、次のことを行うことです。

Set OutMail = OutApp.CreateItem(0)

送信ループの外側。ここに移動する必要があります：

[...]
For p = 1 To addressNum Step 1
  mailList = Sheets("Data").Cells(begRow + p, i) & " ; " & mailList
Next p
Set OutMail = OutApp.CreateItem(0)
With OutMail
[...]

OutMail オブジェクトにどのようなデータが入っているのかわからないため、特定のエラーについてコメントすることはできません。ただし、デバッグに役立つように、次のことをお勧めします。

  1. With OutMailでブロックを閉じますEnd With
  2. Microsoft Outlook 14.0 オブジェクト ライブラリへの参照を設定する
  3. OutApp を Outlook.Application として宣言 ( Dim OutApp as Outlook.Application)
  4. OutMail を Outlook.MailItem として宣言 ( Dim OutMail as Outlook.MailItem)
  5. 次のように OutApp を初期化します。Set OutApp = New Outlook.Application

上記は必要ありませんが (With OutMailブロックを閉じる場合を除いて)、コードの問題を診断するのに役立つ場合があります。

また、新しいバージョンの Outlook を使用している場合は、他のアプリケーション (Excel、Word、Access など) がセキュリティ コントロールによって送信できない場合があることに注意してください: http://support.microsoft.com/kb/263084。

于 2013-01-17T02:33:22.700 に答える
1

試してみてください

  1. レポート ファイルをローカル ドライブに保存する
  2. 最初に 1 つの電子メール アドレスを使用するため、for ループを削除します
  3. ファイル/範囲/ワークブックを 1 つだけ送信します。
  4. 署名などの html タグを削除します。

コード：

With WB '-- workbook
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "myname@myname.com"
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .Body = "Here is a Report on My VBA analysis"
            .Attachments.Add Dest.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\testmail.txt") '-- .xls
            .Send   'or use .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
  • OP のコメントに基づいて更新します。

メールの concat ループを見ると、ワークブックごとにメーリング リストが異なる場合を除き、新しい本が届くたびに行う必要はありません... . メールワークブックの繰り返しからそのループを取り除くことができます。

For p = 1 To addressNum Step 1
    mailList = Sheets("Data").Cells(begRow + p, i) & " ; " & mailList
Next p
于 2013-01-16T23:07:53.520 に答える