[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAでoutlook365が起動せず、困っています。』（坊たん）
VBAでoutlook365の送信画面が現れません。
メール一括作成のボタンを押しても『記載に誤りが無いことを確認しましたか？』『"送信完了しました』のメッセージは出るのですが、送信前のメールの画面が起動しませんし下書ホルダにも保存されません。
EXCELは他のマクロは動作しますし、Outlookはセキュリティ(トラストセンター)設定も有効です。ご教示いただけますようお願いいたします。
下記に対象の記述を記します。
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
＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
objMail.Displayの行が実行されているのは確実だが画面が出ないのか、 その行が実行されているか確認するすべを持たないのかどちらでしょうか？ こちらからはシートの内容が見えないのでとりあえず。 （.:*.ゆ ゅ） 2022/08/25(木) 18:13
If ActiveCell.Offset(i, 2).Value = "○" Then
確実なことはわかりませんが、ここで行方向にもi行分オフセットしているのは予期せぬ動作の原因になっている可能性があります。
（下手の横好き） 2022/08/25(木) 18:27
Do Until ActiveCell.Offset(i, 0).Value = ""
If ActiveCell.Offset(i, 2).Value = "○" Then
ただこの２つがとても怪しいです。
「○」は似た文字が多いので要注意です。
（下手の横好き） 2022/08/25(木) 18:33
Dim rc As VbMsgBoxResult
'送付前の確認メッセージ
rc = MsgBox("記載に誤りが無いことを確認しましたか？", vbYesNo + vbQuestion, "確認")
If rc = vbNo Then
MsgBox "中断しました"
End Sub
End If
Dim objOutlook As Outlook.Application
Dim rngMail As Range
Dim mailTo As String
Dim mSubject As String
Dim mBody1 As String
Dim mBody2 As String
Dim mBody3 As String
Dim filead As String
Dim tenp1 As String
Dim tenp2 As String
Dim asrs1 As String
Dim asrs2 As String
'メール立ち上げ
Set objOutlook = New Outlook.Application
With ThisWorkbook.Worksheets("SheetTest") '作業用ワークシートを設定
mSubject = .Range("B1").Value 'サブジェクトを変数にする
mBody3 = .Range("B2").Value '定型文？を変数にする
filead = .Range("B3").Value '添付ファイルのアドレスを変数にする
tenp1 = .Range("B4").Value '共通添付データのアドレスを読む
tenp2 = .Range("B5").Value
Set rngMail = .Range("B8") '基準セルを設定（※B7+iの初期値1）
End With
filead = filead & "\"
'取引先名が書かれているB列が空欄になるまで続ける
Do Until rngMail.Value = ""
'送付チェック欄(D列)が○なら作業を続ける
If rngMail.Offset(, 2).Value = "○" Then
Dim CC12(1) As String
With rngMail
'個別メールのデータ名称を読む
mBody1 = .Value 'B列
mBody2 = .Offset(, 3).Value 'E列
mailTo = .Offset(, 4).Value 'F列
CC12(0) = .Offset(, 6).Value 'H列
CC12(1) = .Offset(, 8).Value 'J列
asrs1 = .Offset(, 9).Value 'K列
asrs2 = .Offset(, 10).Value 'L列
End With
mBody2 = mBody2 & "様"
'メールを作成する
With objOutlook.CreateItem(olMailTtem)
.to = mailTo
.CC = Join(CC12, ";")
.Subject = mSubject
.Bodyformat = olFormatPlain
.body = mBody1 & vbCrLf & _
mBody2 & vbCrLf & vbCrLf & _
mBody3 & vbCrLf & vbCrLf
With .Attachments
If tenp1 <> "" Then .Add filead & tenp1
If tenp1 <> "" Then .Add filead & tenp2
If asrs1 <> "" Then .Add filead & asrs1
If asrs2 <> "" Then .Add filead & asrs2
End With
.Display
End With
End If
Set rngMail = rngMail.Offset(1)
Loop
Set objOutlook = Nothing
MsgBox "送信完了しました"
End Sub
誠に勝手ながらコードを組み換えてみました。
（おそらく状況は変わらないかと思います）
（下手の横好き） 2022/08/25(木) 19:55
Sub 確認()
'変数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 = ""
'送付チェック欄が○なら作業を続ける
MsgBox ActiveCell.Offset(i, 0).Address(0, 0) & "セルは空白ではありません"
If ActiveCell.Offset(i, 2).Value = "○" Then
MsgBox "メール送信処理"
Else
MsgBox "「" & ActiveCell.Offset(i, 2).Value & "」と「○」は別の文字です。"
End If
i = i + 1
Loop
MsgBox "送信完了しました"
End Sub
確認用のマクロです。
これを動かすとどういうメッセージが出るか教えてください。
（下手の横好き） 2022/08/26(金) 13:41
■１
＞Outlookはセキュリティ(トラストセンター)設定も有効です。
それは関係あるんでしょうか？
深く研究してないのでこちらの勘違いであればごめんなさいですが、結局はアプリケーションであるOutlookを呼び出して、【ExcelVBA】で制御しているので、Outlook側のセキュリティ設定って影響しないんじゃないかとおもいます。
むしろ↓のようにされているので、きちんと参照設定されているか（ExcelVBAが操作できるように設定しているか）といったほうが気になります。
Set objOutlook = New Outlook.Application
■２
ExcelVBAの世界では基本的にシートやセルなど（オブジェクトと言います）は、きちんと指定すれば、いちいちアクティブにしたり選択したりする必要はありません。
また、【標準モジュール】でシートの指定を省略した場合、ActiveSheetが指定されたと見なされるルールです。
したがって、おもってもいないものを処理の対象としないためにも、きちんとオブジェクトを指定されるようにすることをオススメします。
さらに、同様の理由や可読性の観点からもActiveCellに依存しないようにすることをオススメします。
■３
＞送信前のメールの画面が起動しませんし下書ホルダにも保存されません。
提示のコードはご自身が作成されたものかどうかわかりませんが、ご自身が組んだコードの検証や、ネットで見かけたコードの研究をするには【ステップ実行】という方法を使うと、1行ずつ確認しながらコードが実行できます。
したがって、あれおかしいなとおもったら、まずは【ステップ実行】して、想定通りの動きになっているか確認してみましょう。
※「ステップ実行」という言葉を聞いたことがなければ↓をお読み下さい。
【ステップ実行】 https://www.239-programing.com/excel-vba/basic/basic023.html http://plus1excel.web.fc2.com/learning/l301/t405.html
【ブレークポイント】 https://www.239-programing.com/excel-vba/basic/basic022.html https://www.tipsfound.com/vba/01010
また↓も覚えておいて損はないでしょう。
【イミディエイトウィンドウ】 https://www.239-programing.com/excel-vba/basic/basic024.html https://excel-ubara.com/excelvba1/EXCELVBA486.html
【ローカルウィンドウ】 https://excel-ubara.com/excelvba4/EXCEL266.html http://excelvba.pc-users.net/fol8/8_2.html
■４
↓のようにしている割には
Set wsMail = ThisWorkbook.Sheets("リスト")
Worksheets("リスト").～～
↑のような記述が目立ちます。
一方で、せっかく取得した「wsMail」は↓でしか使用してません。
With wsMail
よって「■２」と併せて、全体を見直してみては如何でしょうか
■５
好みの問題ではありますが、インデントに若干の違和感を感じます。（特にIF文のところ）
[[20220816082203]] のような意見もありますので、無理に直せとはいいませんが再考されてみてはどうでしょうか？
■６
ということを踏まえて、私が整理するとこんな感じになります。
興味があれば【ステップ実行】して研究のうえ、必要な部分をご自身のコードに組み込んで下さい。
（理解していただきたいので、丸パクリして完成！はＮＧとします。）
Sub メール作成_整理()
Dim objMail As Object
Dim i As Long, c As Long
Stop 'ブレークポイントの代わり
If MsgBox("記載に誤りが無いことを確認しましたか？", vbYesNo + vbQuestion, "確認") = vbNo Then
MsgBox "中断しました"
Exit Sub '←Endを修正
End If
With ThisWorkbook.Worksheets("リスト")
For i = 8 To .Cells(.Rows.Count, "B").End(xlUp).Row
If .Cells(i, "D").Value = "○" Then
'参照設定してないと"olMailTtem"という定数が使えないので直接0を設定
Set objMail = CreateObject("Outlook.Application").CreateItem(0)
objMail.to = .Cells(i, "F").Value
objMail.CC = .Cells(i, "H").Value & ";" & .Cells(i, "J").Value
objMail.body = .Cells(i, "B").Value & vbCrLf & _
.Cells(i, "E").Value & "様" & vbCrLf & vbCrLf & _
.Range("B2").Value & vbCrLf & vbCrLf
For c = 4 To 5 Step 1
If .Cells(c, "B").Value <> "" Then objMail.Attachments.Add .Range("B3").Value & "\" & .Cells(c, "B").Value
Next c
objMail.Display
End If
Next i
End With
Set objMail = Nothing
MsgBox "内容を確認して送信してください"
End Sub
（もこな２） 2022/08/26(金) 15:29
（もこな２） 2022/08/26(金) 18:22
https://www.moug.net/faq/viewtopic.php?t=81697&sid=93f8f21686398c447bafb0fb9f7f7e2a
（嘘ばっかりだな） 2022/08/26(金) 18:44
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.