ProcessPDFFiles

Sub ProcessPDFFiles()
Dim targetFolder As String
Dim currentWorkbook As Workbook
Dim ws As Worksheet
Dim outlookApp As Object
Dim outlookMail As Object
Dim pdfFile As String
Dim checkRange As Range
Dim resultFileName As String
Dim mailTitle As String
Dim mailBody As String

' 対象フォルダのパスを指定してください
targetFolder = "C:\Your\Target\Folder\Path\"

' 現在のExcelファイルを取得
Set currentWorkbook = ThisWorkbook
Set ws = currentWorkbook.Sheets("設定") ' "設定"シートを参照

' PDFファイルのファイル名を現在のExcelに記録
pdfFile = Dir(targetFolder & "*.pdf")
Do While pdfFile <> ""
ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = pdfFile
pdfFile = Dir
Loop

' List.xlsxを開いてB列のファイル名が対象フォルダにあればA列に✔をつける
If Dir(targetFolder & "List.xlsx") <> "" Then
Dim listWorkbook As Workbook
Set listWorkbook = Workbooks.Open(targetFolder & "List.xlsx")
Set checkRange = listWorkbook.Sheets(1).Range("B:B")

For Each cell In ws.Range("A:A")
If Not IsEmpty(cell.Value) Then
If Not IsError(Application.Match(cell.Value, checkRange, 0)) Then
cell.Offset(0, 1).Value = "✔"
End If
End If
Next cell

listWorkbook.Close SaveChanges:=True
End If

' Outlookを開く
Set outlookApp = CreateObject("Outlook.Application")
Set outlookMail = outlookApp.CreateItem(0)

' 未チェックのファイル名のD列にあるメールアドレスにメール画面を表示
For Each cell In ws.Range("D:D")
If Not IsEmpty(cell.Value) And IsEmpty(cell.Offset(0, 1).Value) Then
' メールのタイトルと本文を"設定"シートから取得
mailTitle = ws.Range("B2").Value
mailBody = ws.Range("B3").Value

' メール画面を表示
With outlookMail
.To = cell.Value
.Subject = mailTitle
.Body = mailBody
.Display
End With
End If
Next cell

' 結果を保存するファイル名に日時を付けて保存
resultFileName = "Result_" & Format(Now(), "YYYYMMDD_HHMMSS") & ".xlsx"
currentWorkbook.SaveAs targetFolder & resultFileName

' Outlookを閉じる
Set outlookApp = Nothing
End Sub