メール作成(Chatgpt)

Sub CreateOutlookMail()
    Dim outlookApp As Object
    Dim outlookMail As Object
    Dim toAddress As String
    Dim ccAddress As String
    Dim mailBody As String

    ' Outlookアプリケーションのインスタンスを作成
    Set outlookApp = CreateObject("Outlook.Application")
    ' 新しいメールアイテムを作成
    Set outlookMail = outlookApp.CreateItem(0)
    
    ' ExcelシートからTOとCCのアドレスを取得
    toAddress = ThisWorkbook.Sheets("Sheet1").Range("A1").Value
    ccAddress = ThisWorkbook.Sheets("Sheet1").Range("B1").Value
    
    ' メールの本文（固定）
    mailBody = "ここに固定のメール本文を記述します。"

    With outlookMail
        .To = toAddress
        .CC = ccAddress
        .Subject = "ここにメールの件名を入力"
        .Body = mailBody
        ' メールを表示（作成のみで自動送信はしない）
        .Display
    End With
    
    ' オブジェクトの解放
    Set outlookMail = Nothing
    Set outlookApp = Nothing
End Sub