- ベストアンサー
Outlook2013自動送信ができない理由と修正方法
oboroxxの回答
- oboroxx
- ベストアンサー率40% (317/792)
内容をきちんと見てないですが、最後のEnd Subはないのでしょうか？ それが原因かも
関連するQ&A
- メール自動送信の際の警告を出さない
EXCEL2007とOutlook2007を使用しています。 私の既存の顧客2000名に対して 次のようなプログラムで、エクセルのメールリストから 複数のアドレスに自動で送信をしたいと考えています。 プログラムは無事動くのですが、 送信の際、１件ずつOutlookの方から 「プログラムによって電子メール メッセージが送信されようとしています。これが予期しない動作である場合は[拒否]をクリックして・・・」 という警告が表示されます。 いちいち「許可」をクリックしないと、次のメッセージ送信に進まないので、困っています これを出さずに、メッセージを送信したいのですが どのような設定をすればよいのでしょうか？ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ Sub Macro1() Dim objOutlook As Object Dim objMsg As Object Dim myAttachments As Object Dim sender As String sender = 1 Do Set objOutlook = CreateObject("Outlook.Application") Set objMsg = objOutlook.CreateItem(0) Set myAttachments = objMsg.Attachments objMsg.To = Range("G1").Offset(sender, 0).Value objMsg.Subject = Range("AA1").Value objMsg.Body = Range("AA2").Value & Chr(10) & Chr(10) & _ Range("AA3").Value & Chr(10) & _ Range("AA4").Value & Chr(10) & _ Range("AA5").Value objMsg.Send Range("G1").Offset(sender, 3).Value = "=now()" sender = sender + 1 Loop Until sender > Range("AB1").Value Set objOutlook = Nothing Set objMsg = Nothing Columns("J:J").Select Selection.Copy Columns("J:J").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False End Sub \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
- ベストアンサー
- オフィス系ソフト
- VBAでエクセルの文をメールに転記
当方エクセル2016使用しています。 エクセルのVBAで、outlookのメールを自動作成したいです。 エクセルの E2に宛先 E3に件名 E4～E6に本文が入っており、 下記VBAでoutlookに各データが入る様にはできました。 しかしエクセルでは文字のサイズや色が異なっているものが、 outlook本文に反映されません。 （1行単位だったり、文字単位だったりでサイズや色が異なる） エクセルに表示されているそのままを outlook本文に表示させるにはどうしたら良いでしょうか。 ******************************** Sub Macro1() Dim toaddress As String Dim subject As String Dim mailbody As String Dim outlookObj As outlook.Application Dim mailItemObj As outlook.mailItem toaddress = Range("E2").Value subject = Range("E3").Value mailbody = Range("E4").Value mailbody = mailbody & vbCrLf & Range("E5").Value mailbody = mailbody & vbCrLf & Range("E6").Value Set outlookObj = CreateObject("Outlook.Application") Set mailItemObj = outlookObj.CreateItem(olMailItem) mailItemObj.BodyFormat = olFormatHTML mailItemObj.To = toaddress mailItemObj.subject = subject mailItemObj.body = mailbody mailItemObj.display Set outlookObj = Nothing Set mailItemObj = Nothing End Sub
- ベストアンサー
- Visual Basic
- エクセルからOUTLOOKでメール送信：２
●前回下記の質問を書かせていただきました。 ---------- エクセルに複数件のデータを記載してあります。 A列 に メールアドレス B列 に 件名 C列 に 本文A D列 に 本文B があるときに連続してメールを立ち上げ送信したいです。 いろいろ試してみましたが全く動きませんでした。 お手隙の際にでもお教え下さい。 マクロのサンプルソースがあると助かります。 よろしくお願いいたします。 ---------------- ●下記の回答をいただきメールの送信までは出来ました。 ---------------- Sub ボタン1_Click() Dim myOLApp As Object ' Dim myDATA As MailItem '### OUTLOOKのオブジェクトを作成後、メールを新規作成する。 Set myOLApp = CreateObject("Outlook.Application") For i=2 To 5 Set myDATA = myOLApp.CreateItem(olMailItem) '### メールの宛先、題名、本文、添付ファイルを設定する。 '（宛先のアドレス） myDATA.to = Range("A" & i).Value ' myDATA.CC = Range("D33").Value myDATA.Subject = Range("B" & i).Value myDATA.Body = Range("C" & i).Value & CHAR(10) & Range("D" & i).Value '### メールを送信 myDATA.Send Next '### お約束の後始末。 Set myDATA = Nothing Set myOLApp = Nothing End Sub こんな感じでしょうか。 For i=2 To 5 と ２行目から５行目です。 うまくいくようでしたら For i=2 To Range("A" &Rows.Count).End(xlUp).Row とでも変更してください。 なんといっても失敗すると大変なリスクが発生するプログラムです。 十分に実験してから運用してください。 ------------------------ ●メール送信は問題なくできておりましたが、 他のCSVリストよりエクセルにデータを引っ張ってきて メールの送信を使用とした所 システムエラーです 80004005 エラーを特定できません。 と言ったエラーが出てくるようになりました。 多分他のシートから引っ張ってくる関数がジャマをしているとは思うのですが、 何かこのエラーを回避する方法はございますでしょうか？ お教え下さい。
- ベストアンサー
- Excel（エクセル）
- Outlookのメールを送信するマクロ
お世話になっております。 Microsoft Outlook2003使用で メール送信のマクロを見様見真似で作ってみたのですが、本文部分がうまくいきません（Best regardsしか表示されません）。 どうすれば正しく反映されるでしょうか？ シートのB1にToアドレスを記入していてTo_addressと名前付 以下、Cc_addressとSubjectも同様にしています。 本文の文章は何行かあり、途中で空白行も入れたいのですが、そこまでまだ手がつけられていません。 本文の文章が3行あるとすると、このマクロではComment1、Comment2、Comment3と名前付しています。 Sub SendEmail() Dim OlApp As Outlook.Application Dim mItem As Outlook.MailItem Dim cell As Range Dim Subj As String Dim EmailAddr As String Dim Recipient As String Dim Msg As String Dim Message As String Dim Sender As String Dim Comments As String Dim Comments2 As String Dim report As String Worksheets("Sheet1").Activate 'Create Outlook object Set OutlookApp = New Outlook.Application 'Get the data Subj = Range("Subject") EmailAddr = Range("To_address") CCAddr = Range("Cc_address") Body = Range("Comment1") & ("Comment2") & ("Comment3") 'Compose message Msg = Msg & Comment1 & vbCrLf & vbCrLf Msg = Msg & Comment2 & vbCrLf & vbCrLf Msg = Msg & "Best regards," & vbCrLf & vbCrLf 'Create Mail Item Set mItem = OutlookApp.CreateItem(olMailItem) With mItem .To = EmailAddr .CC = CCAddr .BCC = BCCAddr .Subject = Subj .Body = Msg .Display End With End Sub 宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
- マクロ Outlook送信メールにエクセルの表を貼り付ける方法
こんにちは。 送りたいメールの形は 数行の文章のあとに、表を貼り付け、また数行の文章という形式です。 Outlookメールでメールを立ち上げて Comment1と2は文章ですのでエクセルのコラムを引っ張ってくるようにしているのですが、 Comment3部分に別のエクセルにある表をメタ貼りし、Comment4でまた文書を引っ張ってくるとさせたいのですが Comment3部分の動きが出来ません。 Dim OlApp As Outlook.Application Dim mItem As Outlook.MailItem Dim cell As Range Dim Subj As String Dim EmailAddr As String Dim Recipient As String Dim Msg As String Dim Message As String Dim Sender As String Dim Comments As String Dim Comments2 As String Dim report As String '日付の設定 DMY = Range("b_date") DM = Format(Range("b_date").Value, "mmdd") Worksheets("mail").Activate 'Create Outlook object Set OutlookApp = New Outlook.Application 'Get the data Subj = Range("B69") & "_" & DM EmailAddr = Range("B63") CCAddr = Range("B66") Comment1 = Range("H63").Value Comment2 = Range("H65").Value Comment3 = この辺りがわかりません Comment4 ＝Range("H67").Value 'Compose message Msg = "<font face=""Arial""><font size=2>" Msg = Msg & Comment1 & "<BR><BR><BR>" Msg = Msg & Comment2 & "<BR><BR><BR>" Msg = Msg & Comment3 & "<BR><BR><BR>" Msg = Comment4 & "<BR><BR><BR><BR>" Msg = Msg & "Best regards," & "<BR><BR>" Msg = Msg & "</font></font>" 'Create Mail Item Set mItem = OutlookApp.CreateItem(olMailItem) With mItem .To = EmailAddr .CC = CCAddr .BCC = BCCAddr .Subject = Subj .HTMLBody = Msg .Display End With End Sub どなたかご存知ではないでしょうか？ 毎回で申し訳ございませんが、どうぞ宜しくお願い致します。
- 締切済み
- オフィス系ソフト
- メール本文に段落を設ける。
ＯＵＴＬＯＯＫのＳＥＮＤメソッドを使って、メールを自動送信する際、次の構文では、本文がだらだらするので、段落を設けたいのですがどのようにすればいいか教えて下さい。 Dim AAA, BBB, CCC As Object Set AAA = CreateObject("OUTLOOK.APPLICATION") Set BBB = AAA.CREATEITEM(OLMAILITEM) BBB.To = "宛先" BBB.Subject = "用件名" BBB.BODY = Range("I2").Value & " " & Range("I3").Value & " " & Range("I4").Value & " " & Range("I5").Value & " " & Range("I6").Value Set CCC = BBB.ATTACHMENTS CCC.Add "添付ファイル名" BBB.SEND Set BBB = Nothing Set CCC = Nothing Set AAA = Nothing
- ベストアンサー
- Visual Basic
- VB5.0 Outlookから自動でメールを送信する
VB5.0からItem.Sendで夜間バッチの処理結果を携帯電話のメールアドレスに送信しようとしています。 Dim objOL As Object Dim ObjMI As Object Set objOL = CreateObject("Outlook.Application") Set ObjMI = objOL .CreateItem(0) ObjMI.Subject = "タイトル" ObjMI.Body = "本文" ObjMI.To = "メールアドレス" ObjMI.Send 実行するとOutLookが起動し、「プログラムの自動的にメールを送信しようとする。よいか？」を問うメッセージが表示され、「はい」ボタンをクリックしなければ、メールを送ることができません。 これはウィルス等の対策だと思うのですが、先述したとおり、夜間バッチ処理の中でこの処理を実行したいので「はい」ボタンを押すことができません。 VBのプログラミング／Outlookの設定でこのメッセージを出なくするまたは、自動で「はい」ボタンをクリックする方法はありませんか。 または、他の方法をご存知の方ご教授ください。 よろしくお願い致します。
- 締切済み
- Visual Basic
- エクセルでOutlookのメールを作成
エクセルでOutlookのメールを作成しようとしています。 一応、以下のコードでできるようです。 質問は、メール本文中の ABC という文字だけを赤い太字にする方法です。教えてください。 Sub test01() Dim mi As Object ' MailItem Dim wdDoc As Object ' Word.Document Dim olApp As Object ' Outlook.Application Set olApp = CreateObject("Outlook.Application") Set mi = olApp.CreateItem(0) mi.To = "test@abc.co.jp" ' 送り先 mi.BodyFormat = 2 ' メールを HTML 形式にする mi.Display ' メールを表示する Set wdDoc = olApp.ActiveInspector.WordEditor ' メールの Word エディタを取得する wdDoc.Windows(1).Document.Range.Text = "本文本文本文本文本文1" _ & vbCrLf & "本文本文本文本文本文2" _ & vbCrLf & "本文ABC本文本文3" With wdDoc.Windows(1).Document.Range.Font .Name = "Meiryo UI" ' メール本文のフォントを "Meiryo UI" .Size = 11 ' フォントサイズを 11 に設定する End With End Sub
- 締切済み
- Excel（エクセル）
- エクセルを使ってOutlookでメール送信
エクセル Sheet1の各セルに下記のように既に入力があります。 To： AA３ (メアド入力済) 件名：AB3 (定型文入力済) 本文：AC3 (定型文入力済) Cｃ： AD3 (メアド入力済) 下記マクロを実行した時 Sheet1のAC3の定型文と 改行して Sheet2のA1からC列の最終入力行までの内容を Outlookメールで飛ばすにはどうしたら宜しいでしょうか? 尚且つ、メールを飛ばしたあと、 Sheet2のA1からC3までは残して2行目以降を消去したいです。 ご教示の程、宜しくお願い致します。 Dim myOLApp As Object Set myOLApp = CreateObject("Outlook.Application") Set myDATA = myOLApp.CreateItem(olMailItem) myDATA.To = Range("AA3").Value myDATA.CC = Range("AD3").Value myDATA.Subject = Range("AB3").Value myDATA.Body = Range("AC3").Value & Worksheets("Sheet2").Range("A1") myDATA.Send Set myDATA = Nothing Set myOLApp = Nothing 【例】 Sheet1 AC3 定型文・・・こんにちは。 Sheet2 A1・・・日付 B1・・・場所 C1・・・担当 A2・・・2014/10/26 B2・・・富士山 C2・・・鈴木 A3・・・2014/12/25 B3・・・TDL C3・・・佐藤
- ベストアンサー
- Excel（エクセル）
- エクセルVBAでメール本文中に画像を挿入する方法
エクセルVBAを使ってアウトルックメールにてメール送信するマクロを作っています。 本文中に画像を挿入する方法をググってますがなかなか出てきません。添付ファイルではなく、本文と本文の間に画像を差し込むイメージです。 メール送信先、本文は同じエクセルのContentsシート、画像はPictシートに格納しています。 Option Explicit Sub SendMail_HTML() Dim contents As Worksheet Dim maillist As Worksheet Dim mailaddress As String, honbun1 As String, honbun2 As String, mailbody As String, strstyle As String Dim i As Long Set contents = ThisWorkbook.Worksheets("Contents") Set maillist = ThisWorkbook.Worksheets("List") ' Picture Dim pict_sheet As Worksheet Set pict_sheet = ThisWorkbook.Worksheets("pict_sheet") 'プログラム3｜Outlookアプリケーションを起動 Dim outlookObj As Outlook.Application Dim myMail As Outlook.MailItem Set outlookObj = CreateObject("Outlook.Application") For i = 2 To 3 ' Email and name setting from Content Sheet client_name = maillist.Range("B" & i).Value mailaddress = maillist.Range("C" & i).Value Set myMail = outlookObj.CreateItem(olMailItem) 'Mail content setting myMail.BodyFormat = 2 myMail.To = mailaddress myMail.Subject = contents.Range("B3").Value honbun1 = Replace(contents.Range("B6").Value, vbLf, "<br>") Dim insp As Outlook.Inspector Set insp = myMail.GetInspector If insp.EditorType = olEditorWord Then Dim doc As Word.Document 'Microsoft Wordを参照 Set doc = insp.WordEditor Dim wrange As Word.Range Set wrange = doc.Range(0, 0) 'カーソルを先頭に 'wrange.Text = honbun1 wrange.MoveEnd Word.WdUnits.wdStory 'カーソルを最後に wrange.Start = wrange.End pict_sheet.Shapes("pict1").Copy 'Pict sheetに入っているpict1を指定 wrange.Paste End If honbun2 = Replace(contents.Range("B8").Value, vbLf, "<br>") myMail.HTMLBody = honbun1 & hoonbun2 myMail.Display 'Send mail 'mymail.Display 'メール表示(ここでは誤送信を防ぐために表示だけにして、メール送信はしない) myMail.Save '下書き保存 myMail.Send maillist.Range("D" & i).Value = "Sent:" & Now() ' Release object Set myMail = Nothing Next 'プログラム12｜オブジェクト解放 Set myMail = Nothing Set outlookObj = Nothing End Sub
- ベストアンサー
- Excel（エクセル）
補足
早速のご連絡をいただき、ありがとうございました。余白の関係で下にかくれていて見えないのですが、End Sub は書いてあります。 一ヶ月程トライしていますが、知識が無いため進んでいません。どうかお力をお貸しいただけませんでしょうか？ よろしくお願い致します。