エクセルVBAでOutlookメール作成

このQ&Aのポイント
  • エクセルVBAでOutlookのメールを自動作成する方法について説明します。
  • 具体的には、Outlookアプリケーションを作成し、メールアイテムを生成し、宛先、件名、本文を設定する方法を示します。
  • また、メールの本文に改行を含める方法や、特定の範囲をリッチテキスト形式で貼り付ける方法についても説明します。
回答を見る
  • ベストアンサー

エクセルVBAでOutlookメール作成

いろいろ検索や質問をしてエクセルVBAで、下記のコードによりOutlookのメールを自動作成できるようになりました。 Sub TEST01() Set oApp = CreateObject("Outlook.Application") Set objMAIL = oApp.CreateItem(0) 'olMailItem=0 strMOJI = "こんにちは!" & vbNewLine & "テストメールです。" & vbNewLine & "よろしくおねがいします。" objMAIL.To = "XXXX@XXXXX.co.jp" '宛先 objMAIL.Subject = "テスト" '件名 objMAIL.Body = strMOJI '本文の代入 objMAIL.display '表示 End Sub それで、実際にはstrMOJI に代入した文字列の下に、このマクロを記述してあるBOOKのSheets("Sheet1").Range("A1:D10")をコピーし、 「リッチテキスト形式」で貼り付けたいのです。 どのようなコードに変えればよいのか教えていただけると助かります。 よろしくお願いいたします。

質問者が選んだベストアンサー

  • ベストアンサー
  • end-u
  • ベストアンサー率79% (496/625)
回答No.3

>ただ、マクロを2回以上走らせると、その都度いくつもOutlookが立ち上がってしまいます。 >これは解消できますか? それは前回QAで手当て済みだったんですけどね。 Dim oApp    As Object Dim objMAIL  As Object Dim strMOJI(1) As String Dim n     As Long On Error Resume Next Set oApp = GetObject(, "Outlook.Application") On Error GoTo 0 If oApp Is Nothing Then   Set oApp = CreateObject("Outlook.Application")   oApp.GetNamespace("MAPI").GetDefaultFolder(6).display End If Set objMAIL = oApp.CreateItem(0) strMOJI(0) = "こんにちは!" & vbCrLf & _        "テストメールです。" & vbCrLf & _        "よろしくおねがいします。" & vbCrLf strMOJI(1) = "以上です。" & vbCrLf & _        "EMAX株式会社" & vbCrLf & _        "Emax" objMAIL.To = "E-Mail_Address_Here" objMAIL.Subject = "テスト" objMAIL.BodyFormat = 2 'HTML形式 objMAIL.Body = strMOJI(0) & strMOJI(1) objMAIL.display n = Len(strMOJI(0)) ActiveSheet.Range("A1:D10").Copy oApp.ActiveInspector.WordEditor.Range(n, n).Paste Application.CutCopyMode = False Set objMAIL = Nothing Set oApp = Nothing BodyFormatはHTML形式じゃないと書式が維持できないような感じです。 #バージョン、もしくは受信側のメーラーによるかもしれませんけど..

emaxemax
質問者

お礼

何から何までありがとうございます。 わからないことだらけですが、やりたいことができました。 感謝いたします。 これからもご指導賜りますようお願い申し上げます。

その他の回答 (2)

  • end-u
  • ベストアンサー率79% (496/625)
回答No.2

>なお、エクセルのバージョンは2010、Outlookは2007です。 EnvelopeVisibleプロパティは同一バージョンでないとエラーになるようです。(by Google君) 次案ですが、Sendkeysはトばして..Outlookのオプションの「メール形式」のところで 「電子メールの編集に..Word..を使用する..」的なチェックがあったらチェック入れておいて下記試してみて下さい。 #Outlook2007持ってないのでアヤフヤ Dim oApp  As Object Dim objMAIL As Object Dim strMOJI As String Set oApp = CreateObject("Outlook.Application") oApp.GetNamespace("MAPI").GetDefaultFolder(6).display Set objMAIL = oApp.CreateItem(0) strMOJI = "こんにちは!" & vbNewLine & _      "テストメールです。" & vbNewLine & _      "よろしくおねがいします。" & vbNewLine objMAIL.To = "E-Mail_Address_Here" objMAIL.Subject = "テスト" objMAIL.BodyFormat = 3 objMAIL.Body = strMOJI objMAIL.display ActiveSheet.Range("A1:D10").Copy With oApp.ActiveInspector.WordEditor.Range   .Collapse 0   .Paste End With Application.CutCopyMode = False Set objMAIL = Nothing Set oApp = Nothing

emaxemax
質問者

お礼

ありがとうございます。 すごいです! > 「電子メールの編集に..Word..を使用する..」的なチェックがあったらチェック入れておいて 見当たらないのでなにもしませんでしたがちゃんと出来ました。 ただ、マクロを2回以上走らせると、その都度いくつもOutlookが立ち上がってしまいます。 これは解消できますか? また、ここまでできると欲が出てしまいました。 下記のように文字列の変数を2つもち、セル範囲を貼り付けた下にも文字列 strMOJI(1) を入れることは可能でしょうか? 勝手なことばかり言って申し訳ありません。 Sub twst02() Dim oApp As Object Dim objMAIL As Object Dim strMOJI(1) As String Set oApp = CreateObject("Outlook.Application") oApp.GetNamespace("MAPI").GetDefaultFolder(6).display Set objMAIL = oApp.CreateItem(0) strMOJI(0) = "こんにちは!" & vbNewLine & _ "テストメールです。" & vbNewLine & _ "よろしくおねがいします。" & vbNewLine strMOJI(1) = "以上です" & vbNewLine & _ "EMAX株式会社" & vbNewLine & _ "Emax" objMAIL.To = "E-Mail_Address_Here" objMAIL.Subject = "テスト" objMAIL.BodyFormat = 3 objMAIL.Body = strMOJI(0) objMAIL.display ActiveSheet.Range("A1:D10").Copy With oApp.ActiveInspector.WordEditor.Range .Collapse 0 .Paste End With Application.CutCopyMode = False Set objMAIL = Nothing Set oApp = Nothing End Sub

  • end-u
  • ベストアンサー率79% (496/625)
回答No.1

HTML形式ではダメなんでしょうか。 こちらにサンプルが載ってますし 『Excel 2002 または Excel 2003 で Visual Basic for Applications を使用して電子メール メッセージでセル範囲を送信する方法』 http://support.microsoft.com/kb/816644/ja 上記例のままでも[この選択範囲を送信する]で送信。 必要なら新規Bookにコピーするように変更したり。 Sub try()   Dim r As Range   Set r = ActiveSheet.Range("A1:D10")   With Workbooks.Add(xlWBATWorksheet)     .EnvelopeVisible = True     With .Sheets(1)       With .MailEnvelope         .Introduction = "こんにちは!" & vbNewLine & "テストメールです。" & vbNewLine & "よろしくおねがいします。"         .Item.To = "E-Mail_Address_Here"         .Item.Subject = "テスト"         '.Item.Send       End With       r.Copy .Range("A1")     End With   End With End Sub 他には ・不安定だけど妥協してSendkeysを使う。 ・(Outlookメール編集にWordを使っている場合)OutlookのActiveInspector.WordEditor.Range.Pasteメソッドを使う。 ・セル範囲をhtm形式に吐き出してHTMLBodyに読み込む。(HTML形式メール) ・Win32API関数を使ってクリップボードからHTML Formatを取り出してHTMLBodyに読み込む。(HTML形式メール) などが考えられない事もないです。

emaxemax
質問者

お礼

end-uさん、前回もありがとうございました。 今回もさっそくありがとうございます。 試してみましたが、参考URLのものも、end-uさんご提示のものも .EnvelopeVisible = True のところで実行時エラー1004「EnvelopeVisibleメソッドは失敗しました。Workbookオブジェクト」となります。 なお、エクセルのバージョンは2010、Outlookは2007です。 > HTML形式ではダメなんでしょうか 貼り付けたあと、編集が可能ならOKです。

関連するQ&A

  • エクセルVBAでOutlookメールの書式を変える

    エクセル2010です。 下記のようなコードでOutlookメールを作成したとき、たとえば  "ABC株式会社" だけを赤字で太文字にするにはどう書けばよいのでしょうか? Sub TEST001()   Dim oApp As Object   Dim objMAIL As Object   Dim strMOJI(1) As String   On Error Resume Next   Set oApp = GetObject(, "Outlook.Application")   On Error GoTo 0   If oApp Is Nothing Then     Set oApp = CreateObject("Outlook.Application")   End If   Set objMAIL = oApp.CreateItem(0)   strMOJI(0) = "こんにちは!" & vbCrLf & _   "色付けテストです。" & vbCrLf & _   "よろしくおねがいします。" & vbCrLf   strMOJI(1) = vbCrLf & _   "以上です。" & vbCrLf & _   "ABC株式会社" & vbCrLf & _   "emaxemax"   objMAIL.To = "xxxx@xxx.co.jp"   objMAIL.CC = "yyyy@xxx.co.jp"   objMAIL.Subject = "テスト"   objMAIL.Body = strMOJI(0) & strMOJI(1)   objMAIL.Display End Sub

  • エクセルVBAでメールに画像添付

    エクセル2010です。 以下のようなVBAでOutlookメールを作成しているのですが、本文の中に画像を添付する方法がわかりません。 下記で言えば strMOJI(0) と strMOJI(1) の間に画像を張り付けたいのです。 画像ファイルを添付するのではなく画像として見えるようにしたいのです。 どのように書けばよろしいでしょうか? Sub TEST001()   Dim oApp As Object   Dim objMAIL As Object   Dim strMOJI(1) As String   On Error Resume Next   Set oApp = GetObject(, "Outlook.Application")   On Error GoTo 0   If oApp Is Nothing Then     Set oApp = CreateObject("Outlook.Application")   End If   Set objMAIL = oApp.CreateItem(0)   strMOJI(0) = "こんにちは!" & vbCrLf & _   "テストです。。" & vbCrLf & _   "よろしくおねがいします。" & vbCrLf   strMOJI(1) = vbCrLf & _   "以上です。" & vbCrLf & _   "ABC株式会社" & vbCrLf & _   "emaxemax"   objMAIL.To = ""   objMAIL.CC = "xxxx@xxx.co.jp"   objMAIL.Subject = "テスト"   objMAIL.Body = strMOJI(0) & strMOJI(1)   objMAIL.Display End Sub

  • エクセルVBAでアウトルックメールの差出人変更

    エクセル2010です。 エクセルからVBAでアウトルックメールを作成するのですが、差出人を自分ではなく部門名のアドレスにしたいのです。 手動ではなんなく差出人を変更できるのですが、VBAでの方法がわかりません。 ネット検索してみると、 SendUsingAccount = Session.Accounts("アカウント名") でできるようなのですが、アカウント名がよくわかりません。 アカウント名に、手動で差出人を変更する際に「名前の選択」で指定する部門の名前や部門のアドレスなどを入れてみましたがオブジェクトが必要とのエラーになってしまいます。 どうすればよいのでしょうか? Sub TEST001() Dim oApp As Object Dim objMAIL As Object Dim strMOJI(1) As String On Error Resume Next Set oApp = GetObject(, "Outlook.Application") On Error GoTo 0 If oApp Is Nothing Then Set oApp = CreateObject("Outlook.Application") End If Set objMAIL = oApp.CreateItem(0) strMOJI(0) = "こんにちは!" & vbCrLf & _ "差出人変更のテストです。。" & vbCrLf & _ "よろしくおねがいします。" & vbCrLf strMOJI(1) = vbCrLf & _ "以上です。" & vbCrLf & _ "ABC株式会社" & vbCrLf & _ "emaxemax" objMAIL.To = "" objMAIL.CC = "xxxx@xxx.co.jp" objMAIL.Subject = "テスト" objMAIL.Body = strMOJI(0) & strMOJI(1) ' objMAIL.SendUsingAccount = Session.Accounts("ABC Gyomubu")'ここでエラー objMAIL.Display End Sub

  • VBAです。OUTLOOKでウンドウを選択

    OUTLOOKでVBAでマクロを組んでいます。 自動的に新規メッセージ画面を開くように設定しています。 何枚もウィンドウが開かれているので、特定の新規メッセージ画面を最前面に表示する事はできないでしょうか? イメージではexcelのsheetをfor each でworksheetsコレクションを全部検索し、activateするイメージです。 コードは簡単に下記のようにメッセージを作成しています。 Dim oApp As New Outlook.Application Dim objmail As Object Set oApp = CreateObject("Outlook.Application") Set objmail = oApp.CreateItem(0) 'olMailItem=0 objmail.To = "宛先" objmail.Subject = "件名" objmail.Body = "本文の代入" objmail.Display '新規メッセージ画面表示 わかりにくいかもしれませんがよろしくお願いします。

  • マクロのメール作成について教えてください

    メール作成に関するマクロで教えて下さい。 下記のマクロで、件名と文章内の#○○○の○○○の部分には 毎回違う3ケタの数字が入ります。 これを例えば、エクセルのセルA1に101と入力されていたら 件名と文章内の○○○の部分を101にした状態でメールを起動させたいです。 また最後の名前○○の部分には、セルA2にデータ入力規則でリストを作成し 選んだ名前を選択すると○○の部分が反映された状態でメールが起動するようにしたいです。 それと文章内の書体をMS P明朝にするにはどうすればよいでしょうか? 教えて下さい。 Sub メールマクロ() Dim oApp As Object Dim objMAIL As Object Dim strMOJI(1) As String Dim n As Long On Error Resume Next Set oApp = GetObject(, "Outlook.Application") On Error GoTo 0 If oApp Is Nothing Then Set oApp = CreateObject("Outlook.Application") oApp.GetNamespace("MAPI").GetDefaultFolder(6).display End If Set objMAIL = oApp.CreateItem(0) strMOJI(0) = "【秘/Confidential】 " & vbCrLf & _ "テスト様" & vbCrLf & _ "CC.関係各位様" & vbCrLf & _ " " & vbCrLf & _ "いつもお世話になっております。" & vbCrLf & _ "#○○○ G1 G2の計測を行いました" & vbCrLf & _ "以上です。" & vbCrLf & _ "EMAX株式会社" & vbCrLf & _ "名前○○" objMAIL.To = "E-Mail_Address_Here" objMAIL.Subject = "#○○○ G1 G2 計測結果" objMAIL.BodyFormat = 3 'リッチテキスト objMAIL.Body = strMOJI(0) objMAIL.display Set objMAIL = Nothing Set oApp = Nothing End Sub

  • 昨日まで使えたVBAにエラー 至急質問です

    VBAについて質問です。 昨日まで使えていたVBAにエラーが出るようになってしまい困っています。 どなたか詳しい方に手直ししていただければと思います。 VBAの内容は、シートの断片的な一部を選択して、OUTLOOKにコピペするという内容です。 メールの件名に特定のセル、本文に特定のレンジが反映されるようになっています。 エラーの内容は、「オブジェクト変数または With ブロック変数が設定されていません。」です。 よろしくお願いいたします。 ===== Sub copy_ICECP_P_1C() Worksheets("★(PAPER)Sheet").Activate Worksheets("★(PAPER)Sheet").Range("A45:A80,A83:A98,A100:A106") _ .Copy Destination:=Worksheets("COPY SHEET").Range("A1") Worksheets("COPY SHEET").Activate Dim oApp As Object Dim objMAIL As Object Dim strMOJI(1) As String Dim n As Long On Error Resume Next Set oApp = GetObject(, "Outlook.Application") On Error GoTo 0 If oApp Is Nothing Then Set oApp = CreateObject("Outlook.Application") oApp.GetNamespace("MAPI").GetDefaultFolder(6).display End If Set objMAIL = oApp.CreateItem(0) strMOJI(1) = " " & vbCrLf objMAIL.subject = Worksheets("COPY SHEET").Range("A59") objMAIL.BodyFormat = 3 'リッチテキスト形式(もともとは 2 で、(HTML形式)だったところを訂正 objMAIL.body = strMOJI(1) objMAIL.display n = Len(strMOJI(1)) ActiveSheet.Range("A1:A59").Copy oApp.ActiveInspector.WordEditor.Range(A1, A59).Paste Application.CutCopyMode = False Set objMAIL = Nothing Set oApp = Nothing Worksheets("★(PAPER)Sheet").Activate End Sub =====

  • エクセルからOutlookのメールを作成

    エクセルからOutlookのメールを作成しているのですが、エクセルの表を画像として貼り付けたところファイルサイズが異常に大きくなってしまいました。 マクロは以下のようなものです。 Sub メール作成() Set App = CreateObject("Outlook.Application") Set objMAIL = App.CreateItem(0) With objMAIL .Display .BodyFormat = 3 Set Doc = .GetInspector.WordEditor End With ThisWorkbook.Worksheets("雛形シート").Range("A5:K35").CopyPicture Doc.Characters.Last.Paste Application.CutCopyMode = False End Sub このマクロで作成するとメールのサイズが2MBになってしまいます。 同じ作業を手動で行うと100kb以内になります。 どうにかファイルサイズを小さくする方法はないでしょうか。

  • アクセスからアウトルックでメールを送りたい

    アクセスからアウトルックでメールを送るために調べたのですが 新しいメッセージを作ってメールを送信するところまではできたのですが 送信ボタンを押下しても、どうやらアウトルックが開いてないと送信できないことがわかりました。 アウトルックは常に立ち上げていません。 なので下記のコードに、アウトルックを立ち上げるコードを入れたのですが わからないので教えていただけますか? Sub メール送信() Dim OlApp As Outlook.Application Dim mItem As Outlook.MailItem Set OlApp = New Outlook.Application Set mItem = OlApp.CreateItem(olMailItem) With mItem .To = "○○@docomo.ne.jp" .Body = "test" .display End With End Sub アウトルックのバージョンは2007です。ご教授よろしくお願いします。

  • VBAのIF構文について

    VBAでまたわからないところが出てきたので質問させてください。 ActiveWorkbookのworksheet1のa1セルに何か文字列が入っていると仮定して、下記のstrSUB に入る文字列をifで分岐させたいのですが、どのような構文が適していますでしょうか? 下記の内容では、エラーになってしまいます。 識者の方々、よろしくお願いいたします。 ----------------------------------------------------------------- Sub test送信メール作成() Dim oApp As Object Dim objMAIL As Object Dim strSUB As String Dim strBODY As String Set oApp = CreateObject("Outlook.Application") Set objMAIL = oApp.CreateItem(0) strSUB = if ActiveWorkbook.Worksheets(1).range("a1") = "abc" then "aaa" Else "bbb" End If strBODY = "a" & vbCrLf _ & "b" & vbCrLf _ & "c" With objMAIL .To = "aaa@bbb.com" .CC = "ccc@ddd.com" .Subject = strSUB .Body = strBODY .Display End With End Sub

  • Excelマクロでメール作成

    Excelマクロでメール作成 Sub aaa() Dim myOutLook Dim olmailItem Dim myitem Dim MyAttachments Set myOutLook = CreateObject("outlook.application") Set myitem = myOutLook.CreateItem(olmailItem) myitem.To = "メールアドレス" myitem.CC = "CCアドレス" myitem.Subject = "件名" myitem.Body = Sheets("シート1").Range("A1") '(1)(本文入力) というところまで出来ていて、'(1)(本文入力)の部分で悩んでいます。 本文をエクセルシート1のA1からC100の範囲でmyitem.Bodyに代入することは出来るでしょうか? (1)の記述だとA1セルを代入することは出来るのですが、Range("A1")をRange("A1:C3")とするとエラーが出てしまいます。 A1からC100の範囲は、空白ありセルデータとなっています。 基本的なことが解っていないための質問になってしまっているかも知れず、申し訳ないのですが、よろしくおねがいします。 OSはxp、Excelは2003、メーラーはOutlookです。

専門家に質問してみよう