Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 11 Pro : Microsoft 365)
【至急お願いします。】VVBAでoutlook365の送信画面が現れません。
投稿日時: 22/08/25 18:25:31
投稿者: 坊たん

VVBAでoutlook365の送信画面が現れません。
メール一括作成のボタンを押しても『記載に誤りが無いことを確認しましたか?』『"送信完了しました』のメッセージは出るのですが、outlookが起動しませんし下書ホルダにも保存されません。
EXCELは他のマクロは動作しますし、Outlookはセキュリティ(トラストセンター)設定も有効です。
ご教示いただけますようお願いいたします。
業務の工数削減に使用を考えていますので、出来る限り早めの回答いただけますと助かります。
参考に対象のサイトのアドレスと記述を下記に記します。
リンク先
https://note.com/corosuke111111/n/n9fa530107bfd#2ziDr
-------------------------------------------------------
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

回答
投稿日時: 22/08/25 18:36:33
投稿者: taitani
投稿者のウェブサイトに移動

問題の切り分けですが、、、
objMail.Display を With wsMail の下に記載して、ステップ実行するとどうなりますか?

回答
投稿日時: 22/08/25 18:43:01
投稿者: taitani
投稿者のウェブサイトに移動

まぁ、メールを作成しなくても、
 
MsgBox "送信完了しました"
 
は実行されますので、 Do Until ActiveCell.Offset(i, 0).Value = "" を最初からスルーしているとか?

投稿日時: 22/08/26 11:10:15
投稿者: 坊たん

taitani様
こんにちは、昨日は返信ありがとうございます。
ご教示いただきました、
『objMail.Display を With wsMail の下に記載して、ステップ実行』→
結果は変わらず『『記載に誤りが無いことを確認しましたか?』『"送信完了しました』』の
メッセージが出るだけでoutlookの送信画面は出ませんでした。
どうすれば、良いやら・・・

回答
投稿日時: 22/08/26 11:20:44
投稿者: taitani
投稿者のウェブサイトに移動

B8 セルが空っぽなのでは?

投稿日時: 22/08/26 12:26:32
投稿者: 坊たん

皆様、色々ありがとうございました。おかげさまで解決しました。