• 締切済み

ExcelVBAからメール本文を取得できません

ExcelのVBAからOutlookのメール本文を取得できません。 エクセル上のデータを自動でOutlookのメール本文にとばすプログラムを作成しています。 Outlookを開き、宛先、件名までは転記できるのですが、本文転記の時にエラーがでます。 <本文転記のプログラム> If Range("A1") = 1 Then .body = Range("B1") ElseIf Range("A1") = 2 Then .body = Range("B1") & vbCrLf & Range("B2") ElseIf Range("A1") = 3 Then .body = Range("B1") & vbCrLf & Range("B2") & vbCrLf & Range("B3") Else .body = Range("B1") & vbCrLf & Range("B2") & vbCrLf & Range("B3") & vbCrLf & Range("B4") End if <エラー内容> (1)A1=1以外はエラーが出ない (2)A1=1の時にエラーが出るPCと、エラーが出ず正常に動くPCがある。 ※何れのPCもWindows10 <質問内容> エラーがでるPCと出ないPCがあるのはなぜでしょうか。 エラーが出ないようにするにはどうしたらよいでしょうか。 ご教示よろしくお願い致します。

みんなの回答

  • HohoPapa
  • ベストアンサー率65% (454/690)
回答No.2

コードが部分的にしか掲示されていないこと どのコード部分でどのようなエラーになるのかの説明が無いので 深追いができません。 少なくとも掲示されたソースコード部分には 問題があるようには思えません。 掲示された情報だけを素直に受け取れば、なにか、 outlookの設定、バージョン、状態、OS (あるいは常駐したセキュリティソフトが疑えるかもしれません。) など、環境に依存した問題が起きているのだろうと思いますが、 それ以上にはわかりません。 VBAを使ってsmtpプロトコルでメールを送信したい。 ということであれば、 WindowsOSに標準搭載された、 CDO(Microsoft Collaboration Data Objects) を使う方法を私は推奨します。 これなら、 実行PCにoutlookなどメールクライアントは不要です。 むろん、outlookに依存することもありません。 http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_800_080.html に、送信用として Function SendMailByCDO... が掲示されていますので これに必要な引数たちを与えて実行すれば 容易に送信できます。

  • skp026
  • ベストアンサー率45% (1011/2238)
回答No.1

メールの形式はどのようになっているか確認済みでしょうか。 状態はBodyFormatプロパティで取得と設定ができます。 このプロパティの詳細は以下です。 https://msdn.microsoft.com/ja-jp/vba/outlook-vba/articles/mailitem-bodyformat-property-outlook 他の環境でエラーが出ても良いように、 取得して、いずれかに表示などすると状況が分かるかもしれません。 あとは他の人からの回答を期待するか、 以下のようなMicrosoftのVBAフォーラムの利用です。 https://social.msdn.microsoft.com/Forums/ja-JP/home?forum=vbajp あまりお役にたてなくてごめんなさい。

utsusemihana
質問者

お礼

VBAフォーラムを利用したら、解決しました。ありがとうございました。

関連するQ&A

  • 日付入力と日数計算

       A       B      1 開始日  H24/4/1       2 終了日  H24/4/30 3  日数     30     上のような表で、 ・B1とB2に日付を入力すると、B3にB1からB2の日数が返ってくる ・B1に日付、B3に日数を入れると、B2にB1からB3日後の日付が返ってくる ・B2に日付、B3に日数を入れると、B1にB2からB3日前の日付が返ってくる ・B列から複数列同じ処理をする というようなことがしたくて、下記のような記述をしました。 (今のところ単列処理ですが・・) Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo error Dim a As Range For Each a In Target If a.Address = "$B$1" Then If Range("B2") > 0 Then Range("B3") = Range("B2") - Range("B1") ElseIf Range("B3") > 0 Then Range("B2") = Range("B1") + Range("B3") - 1 End If End If Next a Dim b As Range For Each b In Target If b.Address = "$B$2" Then If Range("B1") > 0 Then Range("B3") = Range("B2") - Range("B1") + 1 ElseIf Range("B3") > 0 Then Range("B1") = Range("B2") - Range("B3") - 1 Else Range("B2") = "" End If End If Next b Dim c As Range For Each c In Target If c.Address = "$B$3" Then If Range("B1") > 0 Then Range("B2") = Range("B1") + Range("B3") + 1 ElseIf Range("B2") > 0 Then Range("B1") = Range("B2") - Range("B3") - 1 Else Range("B2") = "" End If End If Next c error: End Sub これだと、例えば B1に日付を入力して、B3に日数を入力すると、 B2に日付が返ってくるのですが、B2に日付が返った瞬間にループ処理してしまいます。 (『WorksheetChenge』なので当然なのですが…) どうすればうまくいくか、ご教示お願いいたします。 また、この計算を複数列で行いたいので、それもあわせて 教えていただけると幸いです。 よろしくお願いします。

  • エクセル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でメール本文へのハイパーリンク挿入

    すみませんが質問させて下さい。エクセルVBAにてセルの文章をメール本文へ転記させているのですが、その中の1行がURLとなりハイパーリンクにしたいと思っています。 例えばmailbody = Range("A1")で本文を挿入した場合、A1に”いつもお世話になっています。ファイルはhttp://xxxxxを参考下さい"のhttp://xxxxxの部分だけハイパーリンクにしたいのですがご教授頂けませんでしょうか。宜しくおねがいいたします。

  • エクセル VBAで

    変動する数値が、セル A1に入る状況で、 該当シートに Private Sub Worksheet_Change(ByVal Target As Range) If Range("A1").Value = 1 Then Range("C62").Value = "○" ElseIf Range("A1").Value = 2 Then Range("C62:C63").Value = "○" ElseIf Range("A1").Value = 3 Then Range("C62:C64").Value = "○" ElseIf Range("A1").Value = 4 Then Range("C62:C65").Value = "○" ElseIf Range("A1").Value = 5 Then Range("C62:C66").Value = "○" ElseIf Range("A1").Value = 6 Then Range("C62:C67").Value = "○" ElseIf Range("A1").Value = 7 Then Range("C62:C68").Value = "○" ElseIf Range("A1").Value = 8 Then Range("C62:C69").Value = "○" ElseIf Range("A1").Value = 9 Then Range("C62:C70").Value = "○" ElseIf Range("A1").Value = 10 Then Range("C62:C71").Value = "○" ElseIf Range("A1").Value = 11 Then Range("C62:C72").Value = "○" ElseIf Range("A1").Value = 12 Then Range("C62:C73").Value = "○" ElseIf Range("A1").Value = 13 Then Range("C62:C74").Value = "○" ElseIf Range("A1").Value = 14 Then Range("C62:C75").Value = "○" ElseIf Range("A1").Value = 15 Then Range("C62:C76").Value = "○" End If End Sub と言ったマクロを記述しましたが、 動作がどうにも重くて困っています。 一度、プレビューをした後は特に遅くなります。 何か良い解決方法はありますでしょうか?

  • 本文が最後に表示されてしまいます。

    以下内容でVBAを組んで、メールにコピペさせたんですが 本文が下に行き、コピーしたグラフが先に表示されます。 どうにか、  "お疲れ様です。" & vbCrLf _ & "このメールと同時にプリンターに同様の用紙が印刷されます。" & vbCrLf _ & "印刷された用紙で、前確FAXを送信してください。" &vbCrLf _ & "尚、以下内容で、前確FAX送信いたします。" の部分を本文のトップに持って来れないでしょうか? VBAは下記のように書いております。 Sub Outlookforexcel() '※1 Dim oApp As Object Dim myNameSpace As Object Dim myFolder As Object Dim objMAIL As Object 'メールのオブジェクト Dim strMOJI As String '本文 'outlook 起動 Set oApp = CreateObject("Outlook.Application") Set myNameSpace = oApp.GetNamespace("MAPI") Set myFolder = myNameSpace.GetDefaultFolder(6) '規定のフォルダーを指定 'メールアイテムの作成 Set objMAIL = oApp.CreateItem(0) 'olMailItem=0 直値はいけないと思いつつ、 objMAIL.BodyFormat = 3 'olFormatRichText=3 で リッチテキスト形式へ '宛先・件名・本文 などのデータを代入する objMAIL.To = Range("O1") '宛先 .TO セルO3から代入 objMAIL.Cc = Range("O2") objMAIL.Subject = "【確認FAX】印刷終了以下内容で送信します。" '.Subjectで件名 strMOJI = "お疲れ様です。" & vbCrLf _ & "このメールと同時にプリンターに同様の用紙が印刷されます。" & vbCrLf _ & "印刷された用紙で、確認FAXを送信してください。" & vbCrLf _ & "尚、以下内容で、確認FAX送信いたします。" DoEvents objMAIL.Body = strMOJI '本文の初期化 DoEvents objMAIL.Display '画面表示(Mail入力、編集画面を表示) DoEvents 'Outlook貼り付けのコマンドをコマンドバーから探す Dim oCBs As Object Dim oCtl As Object '今起動中のobjMAIL(メール作成中)のコマンドバーを取り出すよ Set oCBs = objMAIL.GetInspector.CommandBars 'ループで貼り付けの文字を探す、、、 Dim I As Long 'カウンター For I = 1 To 35000 'コントロール I 番目を取り出す Set oCtl = oCBs.FindControl(, I) If Not (oCtl Is Nothing) Then 'オブジェクトが空じゃなければ '文字列でコマンド名を比較する Debug.Print ".Caption " & oCtl.Caption If oCtl.Caption = "貼り付け(&P)" Then ' ↑で見つけたら oCtlはそのままで、ループを抜ける。 Exit For 'これ以上はループしないでいいので。 End If End If Next 'コピー(Excelから)と貼り付け(Outlookへ)処理 Range("A1:I80").Select 'Excel Selection.Copy DoEvents oCtl.Execute '↑で見つけたoCtl 貼り付けコマンド(outlook)を実行 DoEvents objMAIL.send '送信箱へ ※セキュリティの警告メッセージが出るよ 'ここで、普通はオブジェクトの開放など、後始末をする。 Set oCtl = Nothing Set oCBs = Nothing End Sub

  • VBAでの入力

    A1~D5に自動的に順番にデータを入力したいです。 A1→B1→C1→D1→A2→B2→C2→D2→A3・・・ といった感じです。 If range("A1").Value = "" Then  range("A1").Value=○ ElseIf range("A1").Value <> "" Then  range("B2").Value = ○○ ・・・ のようにたくさんIf文を書くしかないのでしょうか。

  • ExcelVBA入力規則・条件付き書式の設定確認

    環境 Windows7 Excel2010 セルに入力規則・条件付き書式が設定されているかを判定する方法をお教え願います。 試した方法は If Not Intersect(Range("A1").SpecialCells(xlCellTypeAllValidation), Range("A2")) Is Nothing Then  MsgBox "入力規則が設定されていています。" End If If Not Intersect(Range("A1").SpecialCells(xlCellTypeAllFormatConditions),Range("A2")) Is Nothing Then  MsgBox "条件付き書式が設定されていています。" End If 上記だと1つも設定されていないシート上で行うと実行時エラーとなります。 調べるとこのようなものを見つけました。 On Error Resume Next Range("A1").Validation.Type Err.Number <> 0 Then→エラーなら未設定となる。 できればエラーを使わず、判定を行いたいです。 ご教授をお願いいたします。

  • 乱数の利用

    僕の通う中学校では、乱数を利用してプログラムを作成することになりました。そしてプログラムを作りましたがステートメントがないと出てきます。どう解決すればよいでしょうか?これがプログラムです。 Dim a,b,c,d,e,f,g a=msgbox("幸せですか?",4) if a=6 then const b="運勢" randomize b=int(rnd*10) select case b case 0,1,2 c=messagebox("吉でした。彼女はいますか?",4) if c=6 then msgbox"90%",,b elseif c=7 then msgbox"60%",,b end if case 3,4,5 d=msgbox("凶でした。友達はいますか?",4) if d=6 then msgbox"60%",,b elseif d=7 then msgbox"20%",,b end if case 6,7 e=msgbox("末吉でした。",4) if e=6 then msgbox"60%",,b elseif e=7 then msgbox"40%",,b end if case 8 f=msgbox("大凶でした。夢はありますか?",4) if f=6 then msgbox"30%",,b elseif f=7 then msgbox"10%",,b end if case else msgbox"100%",,b end if elseif a=7 msgbox"0%" end select

  • VBAについて

    以下のプログラムは、1年間の価格合計を求めるプログラムです。 これを実行するとうまくいくこともありますが、エラーが起きることもあります。 どうやら下記コードが原因のようなのですが、間違いがわかりません。 Target.Offset(0, 1).Value = run * (13 - month) どこが間違っているのでしょうか。 また最終的に、A行かB行のどちらかが更新されたときにこのプログラムを 実行させたいのですが、方法がわかりません。 無知な質問ではありますが、どなたか教えてください。 --------------------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) Dim month As Integer Dim run As Integer If Intersect(Target, Range("A25:A35")) Is Nothing Then Exit Sub Else If Target.Offset(0, -2).Value <> "" Then month = Target.Offset(0, -2).Value month = month - 3 If month = -2 Then month = 10 ElseIf month = -1 Then month = 11 ElseIf month = 0 Then month = 12 End If run = Target.Offset(0, 0).Value Target.Offset(0, 1).Value = run * (13 - month) End If End If 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です。

専門家に質問してみよう