Sub GetPDFAndEmails()
Dim folderPath As String
Dim filesInFolder As String
Dim fileName As String
Dim lastRow As Long
Dim outlookApp As Object
Dim mailItem As Object
Dim ws As Worksheet
Dim i As Long
' 本Excelファイルのパスを取得
folderPath = ThisWorkbook.Path & "\"
' ファイル一覧を取得
filesInFolder = Dir(folderPath & "*.pdf")
' B列の最終行を取得
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
' ファイル名をB列に記録
Do While filesInFolder <> ""
' ファイル名を取得
fileName = filesInFolder
' B列に記録
Cells(lastRow + 1, 2).Value = fileName
' 次の行へ移動
lastRow = lastRow + 1
' 次のファイルを取得
filesInFolder = Dir
Loop
' Outlookアプリケーションを開く
On Error Resume Next
Set outlookApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If outlookApp Is Nothing Then
' Outlookが開かれていない場合は新しく開く
Set outlookApp = CreateObject("Outlook.Application")
End If
' 新しいメールアイテムを作成
Set mailItem = outlookApp.CreateItem(0) ' 0はolMailItemを表します
' リストシートを取得
Set ws = ThisWorkbook.Sheets("リスト")
' C列の最終行を取得
lastRow = ws.Cells(Rows.Count, "C").End(xlUp).Row
' 各行のメールアドレスを宛先に追加（E列が0の場合のみ）
For i = 1 To lastRow
If ws.Cells(i, 5).Value = 0 Then ' E列が0の場合
mailItem.Recipients.Add ws.Cells(i, 3).Value ' C列のメールアドレス
End If
Next i
' メール送信画面を表示
mailItem.Display
' メール作成が完了した旨をメッセージボックスで表示
MsgBox "メールの作成が完了しました。", vbInformation
End Sub
