excelを利用して自動的にメールを送信する！
自動的にメールを送ることができるのならば、相当、時間の有効活用になる気がする。この意見を基にして下記のとおりのプログラムを検討した。VisualStudioとexcelとoutlookがあれば可能だ。
VisualBasic側の設定
① プロジェクト>参照の追加>COM 内のMicrosoft Excel 16.0 Object Libraryにチェックを入れる
② プロジェクト>参照の追加>アセンブリ内のSystem.Net.Httpにチェックを入れる
③ VBのプロシージャーの一番上の箇所に
Imports Microsoft.Office.Interop
と記載する
前もって必要である情報は
◆メールの送信内容
◆相手のメールアドレス
◆相手の名前
◆NOTEPAD2というテキストファイルを保存したフォルダの場所名
◆NOTEPAD2という名称のテキストファイル
◆こちらのメールアドレス(今回は、info@ninproducts.netに設定してある)
◆Bccで送信するメールアドレス
◆Automailという名称のexcelファイル
◆Excelファイルを保存したフォルダ名
である。
下記がVisualStudio内のコードである
Imports Microsoft.Office.Interop
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim memo1 As String = ""
Dim mailaddress As String = ""
Dim customername As String = ""
Dim myfolder As String = ""
mailaddress = "xxxxxxxx@xxxxxxx.xx.xx"
customername = "自動メール送信システムのテスト 様"
memo1 = mailaddress & vbNewLine
memo1 = memo1 & "商品を発送いたしました 【発送番号のご連絡】" & vbNewLine
'下記はBCC宛て用のメールアドレス
memo1 = memo1 & "info@ninproducts.net" & vbNewLine
memo1 = memo1 & "商品を発送いたしました 【発送番号のご連絡】" & vbNewLine
memo1 = memo1 & vbNewLine
memo1 = memo1 & customername & vbNewLine
memo1 = memo1 & "にんにんプロダクツです。" & vbNewLine
memo1 = memo1 & "下記の商品を弊社から発送させていただきました。" & vbNewLine
memo1 = memo1 & "________________________________________________" & vbNewLine
myfolder = "C:\Users\lizlo\Desktop\ちょっと確かめてみよう 自動的にメールを送る"
'notepadに貼り付ける
Dim textfile As IO.StreamWriter
textfile = New IO.StreamWriter(myfolder & "\NOTEPAD2")
textfile.Write(memo1)
textfile.WriteLine()
textfile.Close()
Call openexcel2()
'-------------------------------------------------------------
'excelを自動的に開く。わからないように
End Sub
Private Sub openexcel2()
Dim excelApp As New Excel.Application
Dim excelplace as string=””
Excelplace=”C:\Users\lizlo\Desktop\ちょっと確かめてみよう 自動的にメールを送る\automail.xlsm"
Dim workbook As Excel.Workbook = excelApp.Workbooks.Open(excelplace)
' 表示しないように設定
excelApp.Visible = False
excelApp.DisplayAlerts = False
' ファイルを開く
excelApp.Quit()
' オブジェクト解放
System.Runtime.InteropServices.Marshal.ReleaseComObject(workbook)
System.Runtime.InteropServices.Marshal.ReleaseComObject(excelApp)
'sheet = Nothing
workbook = Nothing
excelApp = Nothing
' 強制的にガベージコレクションを促す
GC.Collect()
GC.WaitForPendingFinalizers()
End Sub
End Class
Excelの設定
Alt+F11を押し、Microsoft visualBasicForApplications>ツール>参照設定 より
Visual Basic For Applications
Microsoft Excel 16.0 Object Library
OLE Automation
Microsoft Office 16.0 Object Library
Microsoft Outlook 16.0 Object Library
Microsoft Outlook16.0 Object Library にチェックを入れる
下記がexcel内のVisualBasic For Applicationsのコードである。宣言箇所は、workbook_open()であることに注意したい。
Private Sub Workbook_Open()
'---------------------------------------------------------
'自動的にメールを送信するマクロ
'最終改定日 2025/04/18
'---------------------------------------------------------
Dim filename As String
filename = ThisWorkbook.Path
ChDir filename
Workbooks.OpenText filename:=filename & "\Notepad2", _
Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
ActiveWindow.SmallScroll Down:=-45
'----------------------------------------------------
‘-----------------------------------------------------
‘DATAという名称のシートを作成する
Dim ws2 As Worksheet
Dim sheetName As String
sheetName = "DATA"
Set ws2 = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
Ws2.Name = sheetName
‘-----------------------------------------------------
Range("A1:A10000").Select
Selection.Copy
Windows("automail.xlsm").Activate
Sheets("DATA").Select
Range("A1").Select
ActiveSheet.Paste
'プログラム2｜シート設定
Dim ws As Worksheet
Set ws = Worksheets("DATA")
'プログラム3｜Outlookアプリケーションを起動
Dim outlookObj As Outlook.Application
Set outlookObj = CreateObject("Outlook.Application")
'プログラム4｜Outlookメールを作成
Dim mymail As Outlook.MailItem
Set mymail = outlookObj.CreateItem(olMailItem)
'----------------------
'データの貼り付け作業
'----------------------
'プログラム5｜メール情報を設定
mymail.BodyFormat = 3 'リッチテキスト形式にてメール送信
mymail.To = ws.Range("A1").Value 'To宛先
mymail.Subject = ws.Range("A2").Value '件名
mymail.BCC = ws.Range("A3").Value 'bcc宛先
'B4以降はまだ書いておりません
'プログラム6｜メール本文を設定
Dim mailbody As String
Dim p As Long
Dim content As String
Dim lastRow As Long
Dim rng As Range
Dim cell As Range
Dim values As String
' 最終行を取得
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
' 範囲を指定
Set rng = Range("A4:A" & lastRow)
' 値を取得
For Each cell In rng
values = values & cell.Value & vbCrLf
Next cell
' メッセージボックスで表示
' MsgBox values
mailbody = values
mymail.Body = mailbody & vbCrLf & vbCrLf
'プログラム7｜メールにファイルを添付場合は下記を設定する
Dim attachedfile As String
'attachedfile = ThisWorkbook.Path & "\" & ws.Range("B9").Value
'If Not attachedfile = "" Then
'mymail.Attachments.Add Source:=attachedfile
'End If
'プログラム8｜メール表示
'mymail.Display 'メール表示(ここでは誤送信を防ぐために表示だけにして、メール送信はしない設定)
'ちなみにmymail.Sendは、自動的にメールを送信する、というモードになる
'プログラム9｜メール保存
'mymail.Save '下書き保存。今回は保存しないため、シングルクオーテーションを付加する
'プログラム10｜自動メール送信
mymail.Send
'プログラム11｜オブジェクト解放
Set outlookObj = Nothing
Set mymail = Nothing
'プログラム12｜プログラム終了
Application.DisplayAlerts = False
Application.Quit
End Sub