2017-01-15 17 views
0

私はそうのようなブックを持っている:VBA:IBMノートで電子メール(添付ファイル付き)を送信しますか?

Column B       Column Q 
C:\Folder\file1.xls    [email protected] 
C:\Folder\file2.xls    [email protected] 
C:\Folder\file3.xls    [email protected] 

私は列Q. に私の受信者のそれぞれに電子メールを送信したい私は1を送信する代わりに、複数の受信者に1通の電子メールを送信したくないしリスト内の受信者ごとの電子メール

メールの件名、本文などは毎回同じですが、メールごとにB欄の対応するワークブックを添付したい場合もあります。

たとえば、受信者1に送信される電子メールにはfile1.xlsファイルが含まれ、受信者2に送信される電子メールにはfile2.xlsというファイルが含まれます。このコードは、1ファイルが添付された1通の電子メールが送信されます

Sub Macro1() 
    ActiveWorkbook.Save 

    Dim iMsg As Object 
    Dim iConf As Object 
    Dim strbody As String 
    Dim fromAdr As String 
    Dim subject As String 
    Dim recip As String 
    Dim numSend As Integer 
    Dim Attachment1 As String 

    ' Mail settings 
    Set iMsg = CreateObject("CDO.Message") 
    Set iConf = CreateObject("CDO.Configuration") 
    iConf.Load -1 ' CDO Source Defaults 
    Set Flds = iConf.Fields 

    ' Mail fields 
    fromAdr = """[email protected]" 
    recip = Range("Q1").Value 
    Debug.Print strbody 
    subject = "Orders fondsen" 
    strbody = strbody & "Hi," & vbNewLine & vbNewLine & _ 
       "Please find the document..." 

    ' Fields layout 
    strbody = strbody & vbNewLine & vbNewLine & "Text" 
    Debug.Print strbody 
    strbody = strbody & vbNewLine & vbNewLine & "Kind regards," 

    ' Location attachment 
    Attachment1 = "file-path" 

    ' send mail 
    On Error GoTo handleError 
    With iMsg 
    Set .Configuration = iConf 
    .To = recip 
    .CC = "" 
    .From = fromAdr 
    .subject = subject 
    .TextBody = strbody 
    .AddAttachment Attachment1 
    .Send 
End With 
    numSend = numSend + 1 
    GoTo skipError 

handleError: 
    numErr = numErr + 1 
    oFile.WriteLine "*** ERROR *** Email for account" & " not sent. Error: " & Err.Number & " " & Err.Description 
skipError: 

    On Error GoTo 0 

    MsgBox "Total number of emails send: " & numSend & vbNewLine & "Total number of errors: " & numErr, vbOKOnly + vbInformation, "Operation finished" 
    GoTo endProgram 
cancelProgram: 
    MsgBox "No emails have been sent.", vbOKOnly + vbExclamation, "Operation cancelled" 

endProgram: 
    Application.Interactive = True 
    Set iMsg = Nothing 
    Set iConf = Nothing 
    Set dp = Nothing 
End Sub 

瞬間:

は、ここに私のコードです。 私はvbaにはまったく新しいので、これを行う方法はわかりませんが、誰かが自分のコードで自分が望むことをするように見せてもらえますか?

P.S.また、私は、この行にエラーを取得し、わからないのです理由:事前に

oFile.WriteLine "*** ERROR *** Email for account" & " not sent. Error: " & Err.Number & " " & Err.Description 

おかげ

答えて

0

あなたのコードは、受信者のそれぞれを選択して、添付ファイルを追加できるように、ループを追加する必要がありますそれぞれについて。

Sub Macro1() 
    ActiveWorkbook.Save 

    Dim iMsg As Object 
    Dim iConf As Object 
    Dim strbody As String 
    Dim fromAdr As String 
    Dim subject As String 
    Dim recip As String 
    Dim numSend As Integer 
    Dim Attachment1 As String 

    ' Mail settings 
    Set iMsg = CreateObject("CDO.Message") 
    Set iConf = CreateObject("CDO.Configuration") 
    iConf.Load -1 ' CDO Source Defaults 
    Set Flds = iConf.Fields 

    ' Add the loop 
    Range("Q1").Select 
    While ActiveCell.Value <> "" 

    ' Mail fields 
    recip = ActiveCell.Value 
    Debug.Print strbody 
    strbody = strbody & "Hi," & vbNewLine & vbNewLine & _ 
       "Please find the document..." 

    ' Fields layout 
    strbody = strbody & vbNewLine & vbNewLine & "Text" 
    Debug.Print strbody 
    strbody = strbody & vbNewLine & vbNewLine & "Kind regards," 

    ' Location attachment 
    Attachment1 = Range("B" & ActiveCell.Row).Value 

    ' send mail 
    On Error GoTo handleError 
    With iMsg 
    Set .Configuration = iConf 
    .To = recip 
    .CC = "" 
    .From = "[email protected]" 
    .subject = "Orders fondsen" 
    .Body = strbody 
    .AddAttachment Attachment1 
    .Send 
End With 

    ActiveCell.Offset(1,0).Select 
    Wend 

    numSend = numSend + 1 
    GoTo skipError 

handleError: 
    numErr = numErr + 1 
    oFile.WriteLine "*** ERROR *** Email for account" & " not sent. Error: " & Err.Number & " " & Err.Description 
skipError: 

    On Error GoTo 0 

    MsgBox "Total number of emails send: " & numSend & vbNewLine & "Total number of errors: " & numErr, vbOKOnly + vbInformation, "Operation finished" 
    GoTo endProgram 
cancelProgram: 
    MsgBox "No emails have been sent.", vbOKOnly + vbExclamation, "Operation cancelled" 

endProgram: 
    Application.Interactive = True 
    Set iMsg = Nothing 
    Set iConf = Nothing 
    Set dp = Nothing 
End Sub 

このコードまたはこれと非常によく似たものが動作するはずです。

関連する問題