objmail.Display メソッドについて

投稿者 : マクロ初心者     投稿日時 : 2023/01/17(Tue) 02:27:49     OS : 未指定     EXCEL : 未指定

---

outlookのMailを作成するマクロを作っているのですが、タスクバーが点滅するだけで、なぜかoutlookがアクティブになりません。
いろいろ調べてみたのですが、うまくいかないのでご教授お願いします。

Sub Mail_Click()

    'Application.ScreenUpdating = False 

    ThisWorkbook.Save 

    Dim toaddress, ccaddress, bccaddress As String  '変数設定：To宛先、cc宛先
    Dim subject, mailBody, credit As String '変数設定：件名、メール本文、クレジット、添付
    Dim File As String 
    Dim oapp As Object, objmail As Object
    
    Set oapp = CreateObject("Outlook.Application")
    Set objmail = oapp.CreateItem(0)
    'objOutlook.ActiveWindow.WindowState = 2
    
    If Worksheets("extract").Cells(100, 2) = 0 Then
     
    MsgBox "処理終了"
    
    Exit Sub
    
    ElseIf Worksheets("受領確認シート").Cells(1, 9) = 1 Then
     
    toaddress = Worksheets("Mail").Range("E1").Value   'To宛先
    ccaddress = Worksheets("Mail").Range("E2").Value   'cc宛先
    subject = Worksheets("Mail").Range("E3").Value         '件名
    mailBody = Worksheets("Mail").Range("E4").Value     'メール本文
    credit = Worksheets("Mail").Range("E5").Value      'クレジット
    File = ("フルパス")    '添付ファイル
    
    Else
    
    toaddress = Worksheets("Mail").Range("B1").Value   'To宛先
    ccaddress = Worksheets("Mail").Range("B2").Value   'cc宛先
    subject = Worksheets("Mail").Range("B3").Value         '件名
    mailBody = Worksheets("Mail").Range("B4").Value     'メール本文
    credit = Worksheets("Mail").Range("B5").Value      'クレジット
    File = ("フルパス")    '添付ファイル
    
    End If
    
    With objmail
    
    .To = toaddress      'to宛先をセット
    .CC = ccaddress      'cc宛先をセット
    .subject = subject   '件名をセット
    .BodyFormat = 2 'HTML形式
    .Attachments.Add (File)  '添付ファイルをセット
    .Body = mailBody & vbCrLf & vbCrLf & credit   'メール本文 改行 改行 クレジット
    .Display 'メール表示
    .GetInspector.Display (False)
    
    End With
     
    Dim n As Long '変数設定：n
    
    n = Cells(3, 9)

    Set wdDoc = ActiveInspector.WordEditor
    
    With wdDoc.Windows(1).Document.Range.Font
    
     .Name = "Meiryo UI"
     .Size = 10
     
     End With
    
     Worksheets("受領確認シート").Activate
     Range(Cells(3, 2), Cells(n, 7)).CopyPicture

     With oapp.ActiveInspector.WordEditor.Windows(1).Selection

     Application.Wait (Now + TimeValue("0:00:01"))
     SendKeys ("^{down 2}")
     SendKeys ("^v")
     SendKeys ("{ENTER}")
     SendKeys ("{down 2}")
     SendKeys ("^{right 3} ")
     
     End With

     Application.CutCopyMode = False 'セルのコピー解除
     'Application.ScreenUpdating = False '描画開始
    
     Set oapp = Nothing 'オブジェクトの解放
     Set objmail = Nothing 'オブジェクトの解放
    
End Sub

投稿者 : さんこう     投稿日時 : 2023/01/17(Tue) 09:05:39

---

Outlookは使わないので外しているかもしれませんが、参考になれば。

＜Excel Outlook アクティブ 前面＞
https://www.google.com/search?q=Excel+Outlook+%E3%82%A2%E3%82%AF%E3%83%86%E3%82%A3%E3%83%96+%E5%89%8D%E9%9D%A2