いつもお世話になっております。
早速ですが、VBAでOutlookを自動で開くプログラムを作成しているのですが、表題の件で実行が出来ません。
他のPCで実行するとすんなり出来るためコード自体には問題は無さそうです。
以下のサイトが参考になるかなと思っておりますが、「オートメーション サーバーをチェックします。」と「システムをチェックします。」の欄がまるで何をやっているのか分からないため、困っております、、
どなたか表題と同じ症状にあった方、原因に心当たりがある方何でもいいのでご教授頂ければ幸いです。
ソースは下記になります。
エラー箇所は「Set outlookObj = CreateObject("Outlook.Application")」になります。
VBA
1Sub sendmail_sample1() 2'---本日のブックチェック 3 Dim ws As Worksheet, flag As Boolean 4 For Each ws In Worksheets 5 If ws.Name = Format(Date, "mmdd") Then flag = True 6 Next ws 7 If flag = True Then 8 '---すべてのブックを保存 9 Dim wb As Workbook 10 For Each wb In Application.Workbooks 11 wb.Save 12 Next wb 13 14 '---コード1|outlookを起動する 15 Dim toaddress, ccaddress, bccaddress As String '変数設定:To宛先、cc宛先、bcc宛先 16 Dim subject, mailBody, credit As String '変数設定:件名、メール本文、クレジット、添付 17 Dim outlookObj As Outlook.Application 'Outlookで使用するオブジェクト生成 18 Dim mailItemObj As Outlook.MailItem 'Outlookで使用するオブジェクト生成 19 'Dim book1 As Workbook 20 21 'Set book1 = Workbook 22 'ThisWorkbook.Saved = True 23 24 '---コード2|差出人、本文、署名を取得する--- 25 toaddress = Range("B2").Value 'To宛先 26 ccaddress = Range("B3").Value 'cc宛先 27 bccaddress = Range("B4").Value 'bcc宛先 28 subject = Month(Now) & "/" & Day(Date) & "(" & WeekdayName(Weekday(Date)) & ")" & " " & Range("B5").Value '件名 29 mailBody = Range("B6").Value 'メール本文 30 credit = Range("B7").Value 'クレジット 31 32 '---コード3|メールを作成して、差出人、本文、署名を入れ込む--- 33 Set outlookObj = CreateObject("Outlook.Application") 34 Set mailItemObj = outlookObj.CreateItem(olMailItem) 35 mailItemObj.BodyFormat = 3 'リッチテキストに変更 36 mailItemObj.To = toaddress 'to宛先をセット 37 mailItemObj.cc = ccaddress 'cc宛先をセット 38 mailItemObj.BCC = bccaddress 'bcc宛先をセット 39 mailItemObj.subject = subject '件名をセット 40 41 '---コード4|メール本文を改行する 42 mailItemObj.Body = mailBody & vbCrLf & vbCrLf & credit 'メール本文 改行 改行 クレジット 43 44 '---コード5|自動で添付ファイルを付ける--- 45 Dim attached As String 46 Dim myattachments As Outlook.Attachments 'Outlookで使用するオブジェクト生成 47 Set myattachments = mailItemObj.Attachments 48 attached = Range("B9").Value & ThisWorkbook.Name '添付ファイル 49 50 myattachments.Add attached 51 52 '---コード5|自動で添付ファイルを付ける--- 53 Dim attached2 As String 54 Dim myattachments2 As Outlook.Attachments 'Outlookで使用するオブジェクト生成 55 Set myattachments2 = mailItemObj.Attachments 56 attached2 = Range("B10").Value '添付ファイル 57 myattachments.Add attached2 58 59 '---コード6|メールを送信する--- 60 mailItemObj.Save '下書き保存 61 mailItemObj.Display 'メール表示(ここでは誤送信を防ぐために表示だけにして、メール送信はしない) 62 'objMAIL.Send 63 64 '---コード7|outlookを閉じる(オブジェクトの解放)--- 65 66 ' Application.Wait Now() + TimeValue("00:00:03") 67 68 'If Application.Wait = 3 Then 69 Set outlookObj = Nothing 70 Set mailItemObj = Nothing 71 Else 72 MsgBox Format(Date, "mmdd") & "が存在してないぞい。出直すがよい。" 73 End If 74 75End Sub
回答2件
あなたの回答
tips
プレビュー