電子メールOutlookのForとLoopの件名を取得しようとしています

Question

私はフォーラムを巡り歩き、複数のコードを組み合わせています。このコードのアイデアは、固定基準に基づいて電子メールを作成することです。この固定基準の複数の一意識別子が電子メール（本文/件名のいずれか）にリストされ、単語文書が電子メールに添付されます。

私は、一意の識別子がリストされ、ワー​​ド文書が添付されている問題があります。これまで私がまとめたコードはここにあります。

Sub Email_Outlook() 

Dim olApp As Outlook.Application 
Dim MailDoc As Outlook.MailItem 
Set olApp = CreateObject("Outlook.Application") 
Set MailDoc = olApp.CreateItem(olMailItem) 

Dim Mail_worksheet As Worksheet 
Dim Mail_worksheet1 As Worksheet 
Set Mail_worksheet = ThisWorkbook.Sheets("Email") 
Set Mail_worksheet1 = ThisWorkbook.Sheets("Send") 

Dim a As Integer 
Dim b As String 

Dim c As Integer 
Dim d As String 

b = ThisWorkbook.Worksheets("Sheet1").Cells(1, 4) 
d = ThisWorkbook.Worksheets("Sheet1").Cells(1, 4) 

For a = 0 To b - 1 

    'Check Production Selection 
    If Mail_worksheet.Cells(17, 2 + a) = "ProductA" And Mail_worksheet.Cells(15, 2 + a) = Mail_worksheet1.Cells(7, 6) Then 
     MailDoc.Subject = "Word document for ProductA - " & Format(Date, "DD MMM YYYY") 

     For c = 0 To d - 1 
     If Mail_worksheet.Cells(17, 2 + a) = "ProductA" And Mail_worksheet.Cells(15, 2 + a) = Mail_worksheet1.Cells(7, 6) Then 
     MailDoc.Body = "Hi," & vbCrLf & vbCrLf & _ 
       "Word documents attached for:" & vbCrLf & _ 
       Mail_worksheet.Cells(4, 2 + c) 

     End If 

     Next c 

    End If 

Next a 

MailDoc.Attachments.Add ("file:///c:\users\word doc\") & Mail_worksheet.Cells(4, 2 + c) & Like "*.docx" 
MailDoc.Display 

End Sub 

Answer 1

私はあなたが二つのループと2つのIf文を持っていた理由を私は把握できなかったので、私はまた

それらを取り出し、それは悪い考えであるあなたは、この

ようなものが必要だと思いますシステムオブジェクトのように見える変数名を使用する。 email_Worksheetは

Sub Email_Outlook() 

    Dim olApp As Outlook.Application 
    Set olApp = CreateObject("Outlook.Application") 

    Dim mailDoc As Outlook.MailItem 
    Set mailDoc = olApp.CreateItem(olMailItem) 

    Dim emailWs As Worksheet 
    Set emailWs = ThisWorkbook.Sheets("Email") 

    Dim sendWs As Worksheet 
    Set sendWs = ThisWorkbook.Sheets("Send") 

    Dim b As Integer 
    b = ThisWorkbook.Worksheets("Sheet1").Range("D1") ' Cells(1, 4) 

    Dim a As Integer 
    For a = 0 To b - 1 

     'Check Production Selection 
     If emailWs.Cells(17, 2 + a) = "ProductA" And emailWs.Cells(15, 2 + a) = sendWs.Cells(7, 6) Then 
      mailDoc.Subject = "Word document for ProductA - " & Format(Date, "DD MMM YYYY") 
      mailDoc.Body = "Hi," & vbCrLf & vbCrLf & _ 
        "Word documents attached for:" & vbCrLf & _ 
        emailWs.Cells(4, 2 + a) 
     End If 

    Next a 

    mailDoc.Attachments.Add "c:\users\word doc\" & emailWs.Cells(4, 2 + c) & ".docx" 
    mailDoc.Display 

End Sub