VBAでoutlook365が起動しません。

質問

VBAでoutlook365が起動しません。EXCELまたは、OUTLOOK設定がおかしいのでしょうか。
メール一括作成のボタンを押しても『記載に誤りが無いことを確認しましたか？』『"送信完了しました』のメッセージは出るのですが、outlookが起動しませんし下書ホルダにも保存されません。
EXCELは他のマクロは動作しますし、Outlookはセキュリティ(トラストセンター)設定も有効です。どなたかご教示いただけますようお願いいたします。
添付でEXCEL画面の画像と下記に対象の記述を記します。
-------------------------------------------------------
Sub メール作成()
Dim objOutlook As Outlook.Application
Dim objMail As Outlook.MailItem
Dim wsMail As Worksheet
Dim filead As String
Dim tenp1 As String
Dim tenp2 As String

'メール立ち上げ
Set objOutlook = New Outlook.Application
Set wsMail = ThisWorkbook.Sheets("リスト")

'添付ファイルのアドレスを変数にする
filead = Worksheets("リスト").Range("B3").Value

'共通添付データのアドレスを読む
tenp1 = filead & "\" & Worksheets("リスト").Range("B4")
tenp2 = filead & "\" & Worksheets("リスト").Range("B5")

Dim kobetsumail1 As String
Dim kobetsumail2 As String
Dim adrs1 As String
Dim asrs2 As String

'変数iを設定。最初は1
Dim i As Long
i = 1

'送付前の確認メッセージ
Dim rc As Long
rc = MsgBox("記載に誤りが無いことを確認しましたか？", vbYesNo + vbQuestion, "確認")

If rc = vbNo Then
MsgBox "中断しました"
End
End If

'基準となるセルを選択
Worksheets("リスト").Select
Range("B7").Select

'取引先名が書かれているB列が空欄になるまで続ける
Do Until ActiveCell.Offset(i, 0).Value = ""

'送付チェック欄が○なら作業を続ける
If ActiveCell.Offset(i, 2).Value = "○" Then

Set objMail = objOutlook.CreateItem(olMailTtem)

'個別メールのデータ名称を読む
Dim CC12(1) As String
CC12(0) = ActiveCell.Offset(i, 6).Value
CC12(1) = ActiveCell.Offset(i, 8).Value

'メールを作成する
With wsMail
objMail.to = ActiveCell.Offset(i, 4).Value
objMail.CC = Join(CC12, ";")
objMail.Subject = Range("B1").Value
objMail.Bodyformat = olFormatPlain
objMail.body = Range("B7").Offset(i, 0) & vbCrLf & Range("E7").Offset(i, 0) & "様" & vbCrLf & vbCrLf & Range("B2").Value & vbCrLf & vbCrLf

kobetsumail1 = ActiveCell.Offset(i, 9).Value
asrs1 = filead & "\" & kobetsumail1

kobetsumail2 = ActiveCell.Offset(i, 10).Value
asrs2 = filead & "\" & kobetsumail2

If Range("B4").Value <> "" Then
objMail.Attachments.Add tenp1
End If

If Range("B5").Value <> "" Then
objMail.Attachments.Add tenp2
End If

If ActiveCell.Offset(i, 9).Value <> "" Then
objMail.Attachments.Add asrs1
End If

If ActiveCell.Offset(i, 10).Value <> "" Then
objMail.Attachments.Add asrs2
End If

objMail.Display

End With

End If

i = i + 1

Loop

Set objOutlook = Nothing

MsgBox "送信完了しました"
End Sub

この投稿のマルチメディアは削除されているためご覧いただけません。

回答No.2

chie65535 · ベストアンサー

objMail.Displayで作ったメールを表示しようとしていますが、送信は行ってませんね。

objMail.Displayの次の行にobjMail.Sendと書いて、送信メソッドを呼び出しましょう。

それと、Outlookの画面をDisplayするメソッドを呼び出してますが、アクティブにするメソッドは呼び出してないので、EXCEL画面の裏に隠れたまま起動し、裏に隠れたまま一度も表示されずにSet objOutlook = Nothingで破棄されているので、画面に表示されないまま終わると思います。

お礼

chie65535様
こんにちは、ご対応ありがとうございました。

補足

回答ありがとうございます。
『画面に表示されないまま終わると思います。』とのことですが、OUTLOOKを起動→画面表示させる方法→特定のフォルダに保存→手動で数件確認→特定のフォルダの下書きメールを
一斉送信を行いたいのですが、記述(構文)とどこに差し込むのかを教えて頂けませんでしょうか。
以上、よろしくお願い致します。

回答No.1

MT765

VBAの参照設定にOutlook Object Libraryは追加されておりますでしょうか。
もしされてないようでしたら下記の手順で追加してみてください。

VBAの　ツール＞参照設定　で　Microsoft Outlook xx.x Object Library にチェックを入れてOKボタンを押す。

見当違いだったらすみません。

お礼

MT765様
こんにちは、返信ありがとうございました。