【Mail_Setting.xlsm】
Sub SendEmail()
Dim OutlookApp As Object
Dim MailItem As Object
Dim mail_list As Variant
Dim i As Integer
Dim LastRow As Long
' C列の最終行を取得
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
ReDim mail_list(0 To LastRow - 2) ' 配列のサイズを指定
For i = 2 To LastRow Step 1
mail_list(i - 2) = Cells(i, 3).Value
Next
' 配列を1つの文字列に結合
Dim EmailAddresses As String
' BCCのメールアドレスを設定
For i = 0 To LastRow - 2 Step 1
EmailAddresses = Join(mail_list, "; ")
' If i = 0 Then
' EmailAddresses = mail_list(0)
' Else
' EmailAddresses = EmailAddresses & "; " & mail_list(i)
' End If
Next
' メール本文の設定
MailBody = Range("メール!B2").Value
' Outlook アプリケーションを取得
On Error Resume Next
Set OutlookApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If OutlookApp Is Nothing Then
Set OutlookApp = CreateObject("Outlook.Application")
End If
' メール作成
Set MailItem = OutlookApp.CreateItem(0)
' メール設定
With MailItem
.BCC = EmailAddresses ' BCC
.subject = Range("メール!B1").Value ' 件名
.Body = Range("メール!B2").Value ' 本文
.Display ' メールを表示
'.Send ' メールを直接送信する場合はコメントを外す
End With
Set MailItem = Nothing
Set OutlookApp = Nothing
ThisWorkbook.Save
Application.Quit
End Sub
【RunExcelMacro.vbs】
Dim obj
Set obj = WScript.CreateObject("Excel.Application")
obj.Visible = false
obj.Workbooks.Open WScript.Arguments(0)
obj.Application.Run WScript.Arguments(1)
【メール自動生成はここをクリック.bat】
@echo off
setlocal enabledelayedexpansion
cd %~dp0
RunExcelMacro.vbs %~dp0\Mail_Setting.xlsm SendEmail
