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
ことが含まれている一つだ場合、あなたはPDF_an_MAシートにソースを変更する必要があると思いますあなたのリスト... – dwirony
ソース - >シート( "Sheet1")=ユーザーID +メール 宛先 - >シート( "PDF_an_MA")=ユーザーID +添付ファイル – smartini