11

さまざまなグループの人々に電子メールを送信するために、Excelフォームにいくつかのボタンを設定しようとしています。
メールアドレスを一覧表示するために、別のワークシートにいくつかの範囲のセルを作成しました。

たとえば、「ボタンA」でOutlookを開き、「ワークシートB：セルD3-D6」の電子メールアドレスのリストを配置します。次に、Outlookで[送信]をクリックするだけです。

Sub Mail_workbook_Outlook_1() 
    'Working in 2000-2010
    'This example send the last saved version of the Activeworkbook
    Dim OutApp As Object 
    Dim OutMail As Object 
         
    EmailTo = Worksheets("Selections").Range("D3:D6") 
         
    Set OutApp = CreateObject("Outlook.Application") 
    Set OutMail = OutApp.CreateItem(0) 
         
    On Error Resume Next 
    With OutMail 
        .To = EmailTo 
        .CC = "person1@email.com;person2@email.com" 
        .BCC = "" 
        .Subject = "RMA #" & Worksheets("RMA").Range("E1") 
        .Body = "Attached to this email is RMA #" & Worksheets("RMA").Range("E1") & ". Please follow the instructions for your department included in this form." 
        .Attachments.Add ActiveWorkbook.FullName 
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
             
        .Display 
    End With 
    On Error Goto 0 
         
    Set OutMail = Nothing 
    Set OutApp = Nothing 
End Sub
4

3 に答える 3

16

範囲内のすべてのセルをループして、文字列"D3:D6"を作成する必要がありToます。単にバリアントに割り当てるだけでは、目的は解決しません。EmailTo範囲を直接割り当てると配列になります。これを行うこともできますが、配列をループしてTo文字列を作成する必要があります

コード

Option Explicit

Sub Mail_workbook_Outlook_1()
     'Working in 2000-2010
     'This example send the last saved version of the Activeworkbook
    Dim OutApp As Object
    Dim OutMail As Object
    Dim emailRng As Range, cl As Range
    Dim sTo As String
    
    Set emailRng = Worksheets("Selections").Range("D3:D6")
    
    For Each cl In emailRng 
        sTo = sTo & ";" & cl.Value
    Next
    
    sTo = Mid(sTo, 2)
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = sTo
        .CC = "person1@email.com;person2@email.com"
        .BCC = ""
        .Subject = "RMA #" & Worksheets("RMA").Range("E1")
        .Body = "Attached to this email is RMA #" & _
        Worksheets("RMA").Range("E1") & _
        ". Please follow the instructions for your department included in this form."
        .Attachments.Add ActiveWorkbook.FullName
         'You can add other files also like this
         '.Attachments.Add ("C:\test.txt")

        .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
于 2013-02-20T16:48:23.447 に答える
0

どちらの答えも正しいです。.TO メソッドを使用する場合、セミカラムは問題ありませんが、addrecipients メソッドでは問題ありません。そこで分割する必要があります。たとえば、次のようになります。

                Dim Splitter() As String
                Splitter = Split(AddrMail, ";")
                For Each Dest In Splitter
                    .Recipients.Add (Trim(Dest))
                Next
于 2020-12-22T09:30:38.480 に答える