- ベストアンサー
エクセルからOUTLOOKでメール送信する方法
- エクセルに複数件のデータを記載してあります。A列にメールアドレス、B列に件名、C列に本文A、D列に本文Bがあります。これらのデータを使用して連続してメールを立ち上げ送信したいですが、うまく動作しません。
- 前回の回答に従ってメール送信を試みましたが、他のCSVリストからデータを引っ張ってくる関数が原因でシステムエラーが発生しました。エラーを回避する方法はありますか?
- エクセルからOUTLOOKでメール送信する際に起きる問題について質問です。複数件のデータをエクセルに記載し、そのデータを使用して連続してメールを送信したいのですが、うまくできません。前回の回答に従って試してみましたが、他のCSVリストからデータを引っ張ってくる関数のせいでシステムエラーが発生しました。エラーを回避する方法を知りたいです。
- みんなの回答 (1)
- 専門家の回答
質問者が選んだベストアンサー
関連するQ&A
- エクセルを使ってOutlookでメール送信
エクセル Sheet1の各セルに下記のように既に入力があります。 To: AA3 (メアド入力済) 件名:AB3 (定型文入力済) 本文:AC3 (定型文入力済) Cc: 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(エクセル)
- Outlook2013自動送信が出来ません。
はじめまして、いつもお世話になっております。 excel vba の学習を始めたばかりの初心者です。 あるサイトで自動でoutloook2013を起動しファイルを添付して送信するマクロを 見つけ送信しようとしましたが、『コンパイルエラー』の為、上手くいきません。 どなたか画像をご確認いただき、修正方法をご教示いただきたく存じます。 よろしくお願いいたします。 以下がコンパイルエラーの出たプロシージャ(抜粋) 黄色のライン→Sub sendmail_sample1() 反転→Dim outlookObj As Outlook.Application 'Outlookで使用するオブジェクト生成 以下がコンパイルエラーの出たプロシージャ(全体) Sub sendmail_sample1() '---コード1|outlookを起動する Dim toaddress, ccaddress, bccaddress As String '変数設定:To宛先、cc宛先、bcc宛先 Dim subject, mailBody, credit As String '変数設定:件名、メール本文、クレジット、添付 Dim outlookObj As Outlook.Application 'Outlookで使用するオブジェクト生成 Dim mailItemObj As Outlook.MailItem 'Outlookで使用するオブジェクト生成 '---コード2|差出人、本文、署名を取得する--- toaddress = Range("B2").Value 'To宛先 ccaddress = Range("B3").Value 'cc宛先 bccaddress = Range("B4").Value 'bcc宛先 subject = Range("B5").Value '件名 mailBody = Range("B6").Value 'メール本文 credit = Range("B7").Value 'クレジット '---コード3|メールを作成して、差出人、本文、署名を入れ込む--- Set outlookObj = CreateObject("Outlook.Application") Set mailItemObj = outlookObj.CreateItem(olMailItem) mailItemObj.BodyFormat = 3 'リッチテキストに変更 mailItemObj.To = toaddress 'to宛先をセット mailItemObj.CC = ccaddress 'cc宛先をセット mailItemObj.BCC = bccaddress 'bcc宛先をセット mailItemObj.subject = subject '件名をセット '---コード4|メール本文を改行する mailItemObj.Body = mailBody & vbCrLf & vbCrLf & credit 'メール本文 改行 改行 クレジット '---コード5|自動で添付ファイルを付ける--- Dim attached As String Dim myattachments As Outlook.Attachments 'Outlookで使用するオブジェクト生成 Set myattachments = mailItemObj.Attachments attached = Range("B9").Value '添付ファイル myattachments.Add attached attached = ThisWorkbook.Path & "outlookメール操作.xlsm" '---コード6|メールを送信する--- 'mailItemObj.Save '下書き保存 mailItemObj.Display 'メール表示(ここでは誤送信を防ぐために表示だけにして、メール送信はしない) '---コード7|outlookを閉じる(オブジェクトの解放)--- Set outlookObj = Nothing Set mailItemObj = Nothing
- ベストアンサー
- Visual Basic
- メール本文に段落を設ける。
OUTLOOKのSENDメソッドを使って、メールを自動送信する際、次の構文では、本文がだらだらするので、段落を設けたいのですがどのようにすればいいか教えて下さい。 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
- EXCEL VBA メール送信でファイル添付
現在、使用しているVBAを利用したメンバー向け案内メール配信で、ファイルを添付できないかと考えております。 G列に入力したアドレスのファイルを添付して送信できればと思うのですが、ご教授願えませんでしょうか。 現在のVBAは企業名、宛先共に変えられるように下記のような形となっております。 添付ファイルも宛先毎に異なります。 B列:送信先メールアドレス C列:メール件名 D列:送信先所属名 E列:送信先宛名 F列:メール本文 コマンドボタンで一括配信となっております。 【以下記述】 Sub Mail_Send() Dim iMsg As Object Dim iConf As Object Dim strbody As String Dim Flds As Variant Dim i, LastRow As Integer ' CDOオブジェクト初期設定 Set iMsg = CreateObject("CDO.Message") Set iConf = CreateObject("CDO.Configuration") iConf.Load -1 ' CDO Source Defaults Set Flds = iConf.Fields With Flds .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Worksheets("Sheet1").Range("C2").Value .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Worksheets("Sheet1").Range("C3").Value .Update End With ' 送信範囲設定 LastRow = Worksheets("Sheet1").Range("B7").End(xlDown).Row ' メール送信ループ For i = 8 To LastRow ' 送信状況メッセージクリア Worksheets("Sheet1").Range("F2").Value = "" ' メール本文作成 strbody = Worksheets("Sheet1").Range("D" & i).Value & vbCrLf & " " & _ Worksheets("Sheet1").Range("E" & i).Value & " 様" & vbCrLf & vbCrLf & _ Worksheets("Sheet1").Range("F" & i).Value ' 改行変換(送信環境によってはここの修正が必要かも) tmpstrbody = Replace(strbody, vbLf, vbCrLf) strbody = Replace(tmpstrbody, vbCr & vbCrLf, vbCrLf) ' メール送信 With iMsg Set .Configuration = iConf .From = Worksheets("Sheet1").Range("C4").Value .To = Worksheets("Sheet1").Range("B" & i).Value .BCC = Worksheets("Sheet1").Range("C5").Value .Subject = Worksheets("Sheet1").Range("C" & i).Value .TextBody = strbody .Send End With ' 送信状況メッセージ更新 Worksheets("Sheet1").Range("F2").Value = Worksheets("Sheet1").Range("B" & i).Value & " まで送信成功!" ' 3秒停止 Application.Wait [ NOW() + "0:00:03" ] Next i End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルからアウトルックへ移行について
エクセルでコマンドボタンを使いアウトルックに移行するPRGがあります。 最近、PCをXPからVistaに乗り換えたところmycontent.sendのところで デバックエラー(実行時エラー"287")が出て動きません。 (XPでは動作します) (エクセル2002で作成した物をエクセル2007で動かそうとしています) どういった解決策があるでしょうか? 皆様、よろしくお願い致します。 Sub Eメール送信() 'Outlook上にデータ書込み msg = "MSG=" msg = msg & Cells(2, 2) Range("B2") = msg Set myoutlook = CreateObject("Outlook.Application") Set myNameSpace = myoutlook.GetNamespace("MAPI") Set mycontent = myoutlook.Createitem(0) mycontent.To = Range("B1").Value '宛先アドレス mycontent.Body = Range("B2").Value '本文 mycontent.Send 'メール送信 Set mycontent = Nothing Set myNameSpace = Nothing Set myoutlook = Nothing Range("B2").Select ans = MsgBox("MSGは正しくOutlookへ移行しました。「to Outlook」をクリックして送受信の操作を行って下さい。", 0 + 64, "注意") Selection.ClearContents End Sub
- 締切済み
- Visual Basic
- Excel collectionについて VBA
Dim Mydata As New Collection Dim i As Long Dim EndNumber As Long On Error Resume Next 'データを登録する間、エラーを無視する For i = 2 To EndNumber '2行目から最終行までチェック Mydata.Add Range("J" & i).Value, Range("J" & i).Value 'J列のデータ取得 Next i On Error GoTo 0 i = 1 For Each A In Mydata Worksheets("Sheet1").Range("A" & i).Value = A i = i + 1 Next A 現在見ているシートの重複しない項目を 別シートに書き込みしているプログラムになります。 様々なサイトを参考にさせて頂き、 上記のような結果になり、 文字列は取得できるようになりました。 しかし、もとになるデータがある位置に(例は、J列) 数値が入っていると上手くコレクションに入ってくれません。 J列に文字列(りんご、ごりらなど)が入っている場合は 重複しない項目がコレクションに格納されていきます。 J列に文字列(0,1)が入っていた場合、 重複しない項目もなにも無く、 ローカルのMydataの中には<変数無し>とありました。 このプログラムの何処を直せば、数値をコレクションとして取得できますか? ちなみに、EndNumberには最終行の数値が入っています。 >Mydata.Add Range("J" & i).Value, Range("J" & i).Value 'J列のデータ取得 .valueを.stringにしても効果はありませんでした。 回答よろしくお願いいたします。
- ベストアンサー
- Excel(エクセル)
- Excel VBA Outlook送信済メール削除
お世話になります。 現在、Excel VBA(Excel2010)で、Outlook2010を立ち上げて、添付のExcelの表のE列【GL承認日】に日付を入れると、日付書式を確認して、メールが送信されるVBAを作成しています。 そこで、下記のVBAの下の方にある「myMail.Send」でメールが送信されるようになっていて、メールが送信された後、Outlookの【送信済みフォルダ】に送信済みメールが入ります。 その送信済みメールを【送信済みフォルダ】に入ったら、完全に削除するようにしたいのですが、どのようにVBAを追加すれば宜しいでしょうか? ご存知の方、是非ご教示宜しくお願い致します。 ↓該当のExcel VBAです。 ---------------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) Dim myOL As Object Dim myMail As Object Dim myBody As String Dim n As Long Dim mDate As Variant On Error Resume Next 'GL承認日の列の日付書式指定 mDate = Array("yyyy/mm/dd") 'GL承認日の該当セルの日付書式を確認 For Each wz In mDate 'GL承認日の該当セルが空白でない場合は以下を処理 If Cells(Target.Row, Target.Column).Value <> "" Then If InStr(Cells(Target.Row, Target.Column).NumberFormatLocal, wz) > 0 Then 'メールアプリケーションをOutlookに指定 Set myOL = GetObject(, "Outlook.Application") On Error GoTo 0 If myOL Is Nothing Then Set myOL = CreateObject("Outlook.Application") myOL.getnamespace("MAPI").GetDefaultfFolder(6).display End If Set myMail = myOL.CreateItem(0) 'B、C行のセル位置を数値で取得 n = Cells(Target.Row, Target.Column).Row 'メール本文 myBody = "振替伝票入力のGL承認が " & Format(Cells(Target.Row, Target.Column).Value, "yyyy/mm/dd") _ & " に完了しました。" & vbNewLine & vbNewLine _ & "●振替伝票No: " & Range("C" & n).Value & vbNewLine & vbNewLine _ & "================================" & vbNewLine _ & " ▲▲部 ××グループ" & vbNewLine _ & "================================" If Range("B" & n).Value = "ooo" Then myMail.to = "ooo@***.co.jp" 'ElseIf Range("B" & n).Value = "qqq" Then ' myMail.To = "qqq@***.co.jp" End If 'メールのタイトル、本文、本文の形式を指定 myMail.Subject = "【振替伝票 GL承認完了通知】" myMail.Body = myBody myMail.BodyFormat = 1 'テキスト形式 'メールを送信 myMail.Send (↑此処でメールが【送信済みフォルダ】に入りますが、このタイミングで【送信済みフォルダ】に入ったメールを完全削除したいです。) '変数をリセット Set myMail = Nothing Set myOL = Nothing Else Exit Sub End If End If Next Exit Sub End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルからOUTLOOKでメール送信
エクセルに複数件のデータを記載してあります。 A列 に メールアドレス B列 に 件名 C列 に 本文A D列 に 本文B があるときに連続してメールを立ち上げ送信したいです。 いろいろ試してみましたが全く動きませんでした。 お手隙の際にでもお教え下さい。 マクロのサンプルソースがあると助かります。 よろしくお願いいたします。
- ベストアンサー
- Excel(エクセル)
- エクセル2013 セル内の ( から右側を削除
A列のセルにある文字列の中に ( が存在したら ( から右側を削除して左側だけをA列に表示したいのですが、 ( が存在するセルと存在しないセルがあります。 下記コードを現在使用していますが ( が存在しないとエラーになってしまうため エラーを回避するコードを教えてください。 宜しくお願い致します。 lastRow = Range("A" & Rows.Count).End(xlUp).Row For i = 2 To lastRow r = Application.WorksheetFunction.Search("(", Range("A" & i), 1) k = Left(Range("A" & i).Value, r - 1) Range("A" & i).Value = k Next
- ベストアンサー
- Excel(エクセル)
- VBのテキストボックスの内容をExcelのセルに書き加える
VBを実行し、フォームのテキストボックスに入力された文字列を あらかじめ読み込んでおいた既存のExcelシートのセルに 書き足したいです。 そのExcelシートのセルにはすでに「001」などの数字が 入っているのですが、その数字の前に「AB01」などの文字列を付け加えたいのです。 自分なりに作ってみましたがうまくいきません。 とりあえずソースを載せます。 わかる方いらっしゃいましたらよろしくお願いします。 Private Sub Command1_Click() Set xlApp = CreateObject("Excel.Application") xlFileName = strFileName Set xlBook = xlApp.Workbooks.Open(xlFileName) Set xlNameSheet = xlBook.Sheets.Item(1) cnt = 0 i = xlNameSheet.Range("A1").CurrentRegion.Rows.Count For i = 1 To 65 shusseki = xlNameSheet.Cells(i, 5).Value If IsNumeric(shusseki) Then cnt = cnt + 1 For j = 1 To 5 xlNewSheet.Cells(cnt, j).Value = xlNameSheet.Cells(i, j).Value xlNewSheet.Cells(cnt, 1).Value = Form10.Text1 Next j End If Next i xlApp.Visible = True Set xlNameSheet = Nothing Set xlNewSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing End Sub
- 締切済み
- Visual Basic
お礼
試してみます! ありがとうございます!