ray88’s diary

お仕事で困ったとき用の自分用の覚書

修正

Docmd.SelectObject "フォーム名"
Sub メールテスト()

    Dim blResult As Boolean
    
    blResult = fncCreateNewMail("tarou-yamada@pipty.com", "重要フラグメール", "フラグテスト")
End Sub
Function fncCreateNewMail(strTo As String, strCc As String, _
                          strSubject As String, StrBody As String, _
                          Optional StrAttachPath As String) As Boolean

 '-------------------------------------------
 '機能:新規メールを作成して送信する
 '引数1:宛先To
 '引数2:宛先CC
 '引数3:件名
 '引数4:本文
 '引数5:添付ファイルパス(省略可)
 '戻り値:送信結果をTrueまたはFalseで返す
 '--------------------------------------------
   Dim olApp As Object
   Dim MailItem As Object
   
   'Outlookを起動する
      Set olApp = CreateObject("Outlook.Application")
   
    'メールを作成する
   Set MailItem = olApp.CreateItem(0)
   
   With MailItem
    '送信先を指定する
    .Recipients.Add(strTo).Type = 1
    'CCを指定
    .Recipients.Add(strCc).Type = 2
    .Subject = strSubject
    '本文を指定する
    .Body = StrBody
    'フラグをセットする
'    .Importance = 2   'olImportanceHigh=2
        '添付ファイルを指定する
'        .Attachments.Add ThisWorkbook.Path & "\Sample.xlsx"
'        .Send
        'テスト用(送信せずディスプレイ表示のみ)
        'ひとつ上の「.Send」をコメントアウトしてテストする際に使用する
        .Display
    End With
End Function