2017-12-28 21 views
0

Excelシートがあります(「Sheet2」と呼ぶことにしよう)。[A]列に200の名前を付け、次の列に名前を添付しますそれに[B]する。(VBA)複数の添付ファイルを含むメールをリストに複写する

各名前のメールアドレスを持つ別のシート( "Sheet1")があります。重要! - >このSheet1リストは、200の名前を持つ最初のリストよりも長いです。

シート「Sheet2」(列[A])に重複したエントリがありますが、添付ファイルが異なるようです。

私は、何とか私はそうすることを管理することはできませんだけで、ユーザーに必要なすべての添付を1通のメールを送信したいと思い

...

私が得たループは、リスト内のすべてのユーザーに対してメールを作成し、「シート1」しかし、私はリスト "シート2"のユーザーのメールが必要です。

ここで答えを見つけることを希望します。ありがとう!

マイコード:

Sub Mails() 

Application.ScreenUpdating = False 
Application.EnableEvents = False 
Application.Calculation = xlCalculationManual 


Dim FileName As Variant 
Dim wkbSource As Workbook 
Dim wksSource As Worksheet 
Dim wksDest As Worksheet 


Set wksDest = ThisWorkbook.Worksheets("Sheet2") 
Set wksSource = ThisWorkbook.Worksheets("Sheet1") 

Dim LastRowSource As Long 
LastRowSource = wksSource.Cells(wksSource.Rows.Count, "A").End(xlUp).Row 

Dim LastRowDest As Long 
LastRowDest = wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp).Row 

For i = 1 To LastRowSource 

    Dim OutApp As Object 
    Dim OutMail As Object 
    Dim CC As String 

    Set OutApp = CreateObject("Outlook.Application") 
    Set OutMail = OutApp.CreateItem(0) 
    Dim TC_User As String 
    Dim TC_Attachement As String 
    Dim TC_File As String 

    TC_User = "" 
    CC = "" 
    TC_User = wksSource.Range("A" & i) 
    TC_USer_mail = wksSource.Range("B" & i) 
    TC_Attachement = "" 

     With OutMail 
      .To = TC_USer_mail 
      .BCC = "" 
      .Importance = 2 
      .Subject = "for you" 
      .HTMLBody = "<body style='font-family:arial;font-size:13'>" & _ 
         "<b>############################################<br>" & _ 
         "Diese Mail wurde automatisch erstellt<br>" & _ 
         "############################################</b><br><br>" & _ 
          "Hallo " & TC_User & "," & "<br><br>" & _ 
          "blabla.<br><br>" & _ 
         "</body>" 
      For g = 2 To LastRowDest 
       If wksDest.Range("A" & g) = TC_User Then 

        TC_File = wksDest.Range("B" & g) 
        TC_Attachement = "C:\Users\bla\Documents" & "\" & TC_File 

        If Dir(TC_Attachement) <> "" Then 
         .Attachments.Add TC_Attachement 
         'GoTo nextvar 

         Else 
        End If 
       End If 
'nextvar: 
      Next g 

     .Display 
     End With 
     On Error GoTo 0 

     Set OutMail = Nothing 
     Set OutApp = Nothing 
Next i 

Application.EnableEvents = True 
Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True 
Ende: 

End Sub 
+0

ことが含まれている一つだ場合、あなたはPDF_an_MAシートにソースを変更する必要があると思いますあなたのリスト... – dwirony

+0

ソース - >シート( "Sheet1")=ユーザーID +メール 宛先 - >シート( "PDF_an_MA")=ユーザーID +添付ファイル – smartini

答えて

0

だから、それぞれの名前ための添付ファイルの数が不明(つまり、必ずしも1。)があり、あなたがそれらを一緒にグループ化された必要がありますか? (と、それは一回のことのように聞こえる?)

ちょうどコピーしてアップ列ラインように、他の1つの下の表を貼り付け、その後、単純にリストをソートします(→SortData)を移動して名前は一緒にグループ化されます。

ここから、送信プロセスを自動化するためにリストを整理できる方法がいくつかあります。その音によって、ほとんどの名前は1つの添付ファイルを持っているので、あなたが行っていたように送信し、手動で追加のものを送信します。

手動でワンオフタスクを処理することは、自動化しようとするよりも、しばしば迅速かつ容易になることがあります。

これは(簡単なAccessテーブルのような。)ソースデータを整理するためのより良い方法を探してみてください、その後、定期的なタスクであることを行っている場合は

+0

迅速な対応に感謝します。これは確かに定期的な作業であり、ユーザーは手動の作業を一切行うべきではありません。 – smartini

+0

さて、ソートを自動化して(コード行だけです)、リストを1行ずつループさせることができます: - 前の行と同じではない名前が見つかった場合、それは新しい電子メールです前のものがあればそれを送ることができます)。 - 次に、次の行が現在の行と同じ名前であれば、追加する添付ファイルです。空白のセルまで繰り返します。 – ashleedawg

+0

しかし、これは望ましくない受取人にメールを送信することで私の問題を解決するのではないでしょうか? – smartini

1

[OK]を、私は私の解決策を見つけました。多分それは優雅ではないが、それは機能する。 私はこのコードを "With OutMail" - Statementの直前に書いています。 メールデータベースのUser-IDが実際に受取人のリストに含まれているかどうかを確認します。そうでない場合、このUser-IDはスキップされます。あなたがここに `Sheet1`(` wksSource = ThisWorkbook.Worksheets(「シート1」) `)からリストを取っている

For j = 2 To LastRowSource 
     If TC_User = wksDest.Range("A" & j) Then 
      GoTo weiter_j 
     End If 
    Next j 
GoTo Ende: 

weiter_j: 
関連する問題