\ あなたにピッタリの銘柄がみつかる /

みんかぶプレミアムを無料体験!

プランをみる

お知らせ

読み込みに失敗しました。

しばらくしてからもう一度お試しください。

重要なお知らせ すべて見る

MatsuLingさんのブログ

最新一覧へ

« 前へ24件目 / 全169件次へ »
ブログ

Excel Mail Send


Sub Excel_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
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Worksheets("Sheet1").Range("C6").Value
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Worksheets("Sheet1").Range("C7").Value
.Update
End With


' 送信範囲設定
LastRow = Worksheets("Sheet1").Range("B9").End(xlDown).Row

' メール送信ループ
For i = 10 To LastRow

' 送信状況メッセージクリア
Worksheets("Sheet1").Range("F2").Value = ""

' メール本文作成
strbody = 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
.BodyPart.Charset = "utf-8"
.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
コメントを書く
コメントを投稿するには、ログイン(無料会員登録)が必要です。

ネット証券比較

みんかぶおすすめ