共有ネットワークドライブ上にExcelファイルを台帳として
保管しております。
誰かが追記したときに、他の人へも更新したことをメール
連絡しているのですが、この作業を省力化したく思います。
記入してあるセルはA、B、C列だけ、連絡先も固定なんでもしかしたらマクロ化できるのかなぁと思うのですが如何でしょうか?
A列:年月日、B列:件名、C列:記入者です。
最下行を読み取り
A & "日に" & C & "さんが & B"を追加しました"
と云う内容でメールを送れたら嬉しいです。
保存時若しくは終了時にマクロでメール送信できればいいなと思うのですが、どなたかご興味あればさわりだけでもサンプル作っていただけませんでしょうか?
No.1ベストアンサー
- 回答日時:
VBAでメールの送受信をするのは、簡単そうですが標準コントロールがないんですね。
APIでも無理なので外部コントロールを導入するしかありません。「BASP21」というコンポーネントに付属している「BSMTP.DLL」をシステムディレクトリにコピーすれば出来るかも知れません。
「BASP21」http://www.hi-ho.ne.jp/babaq/basp21.html
下は適当に作ってみたサンプルです。
ThisWorkbook内に貼り付ければいいと思います。
Option Explicit
'SendMail関数の宣言
Declare Function SendMail Lib "bsmtp" _
(szServer As String, szTo As String, _
szFrom As String, szSubject As String, szBody As String, szFile As String) As String
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ret As String '戻り値
Dim szServer As String, szTo As String, szFrom As String
Dim szSubject As String, szBody As String, szFile As String
Dim readRow As Long '最終行
Dim dtmDate As Date
Dim strSubject As String
Dim strMember As String
Dim fs, a As Object
On Error GoTo Err_Handler
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\log.txt", True)
szServer = "smtp.ocn.ne.jp" 'サーバー名
szTo = "*@kantei.go.jp" '宛先
szFrom = "**@kantei.go.jp" '送信元
szSubject = "更新" 'メールの主題
szFile = ""
'最終行から入力データを取得
With Worksheets("Sheet1") 'シート名
readRow = .Cells.SpecialCells(xlCellTypeLastCell).Row + 1
.Cells(readRow, 1) = dtmDate '年月日
.Cells(readRow, 2) = strSubject '件名
.Cells(readRow, 3) = strMember '記入者
End With
If dtmDate = Date Then '年月日が今日ならば
szBody = dtmDate & "に" & strMember & "さんが" & strSubject & _
"を追加しました"
ret = SendMail(szServer, szTo, szFrom, szSubject, szBody, szFile)
' パラメータエラーのときは、戻り値にエラーメッセージが返ります。
If Len(ret) <> 0 Then
a.WriteLine (Date & " " & Time & " " & ret & "-" & szTo & "-" & szBody)
MsgBox "エラー"
Else
MsgBox "完了"
End If
End If
GoTo Exit_sub
Err_Handler:
MsgBox Err.Description, vbCritical, "Error"
GoTo Exit_sub
Exit_sub:
a.Close
End Sub
本当に適当なので動かない可能性大です(;^_^A
適宜修正下さい。
参考URL:http://www.hi-ho.ne.jp/babaq/basp21.html
No.2
- 回答日時:
1で回答したものです。
下のコードを自分で試してみましたがやっぱり駄目でした(^^ゞ
成功例は以下の通りです。
ThisWorkbook内に
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call main
End Sub
「標準モジュール」を追加してその中に
Option Explicit
'SendMail関数の宣言
Declare Function SendMail Lib "bsmtp" _
(szServer As String, szTo As String, _
szFrom As String, szSubject As String, szBody As String, szFile As String) As String
Public Sub main()
Dim ret As String '戻り値
Dim szServer As String, szTo As String, szFrom As String
Dim szSubject As String, szBody As String, szFile As String
Dim readRow As Long '最終行
Dim dtmDate As Date
Dim strSubject As String
Dim strMember As String
Dim fs, a As Object
On Error GoTo Err_Handler
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\log.txt", True)
szServer = "smtp02.odn.ne.jp" 'サーバー名
szTo = "*@japan.104.net" '宛先
szFrom = "**@japan.104.net" '送信元
szSubject = "更新" 'メールの主題
szFile = ""
'最終行から入力データを取得
With Worksheets("Sheet1") 'シート名
readRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
dtmDate = .Cells(readRow, 1) '年月日
strSubject = .Cells(readRow, 2) '件名
strMember = .Cells(readRow, 3) '記入者
End With
If dtmDate = Date Then '年月日が今日ならば
szBody = dtmDate & "に" & strMember & "さんが" & strSubject & _
"を追加しました"
ret = SendMail(szServer, szTo, szFrom, szSubject, szBody, szFile)
' パラメータエラーのときは、戻り値にエラーメッセージが返ります。
If Len(ret) <> 0 Then
a.WriteLine (Date & " " & Time & " " & ret & "-" & szTo & "-" & szBody)
MsgBox "エラー"
Else
MsgBox "完了"
End If
End If
GoTo Exit_sub
Err_Handler:
MsgBox Err.Description, vbCritical, "Error"
GoTo Exit_sub
Exit_sub:
a.Close
End Sub
これでファイルを閉じる際にメールが送信されます(Win2K&Excel2000にて確認)
なお、「bsmtp.dll」はシステムディレクトリ以外でも上手く機能します。その場合は
Declare Function SendMail Lib "bsmtp" _
を
Declare Function SendMail Lib "d:\bsmtp.dll" _
というようにフルパスで指定してやれば良いようです。
dll配付等が面倒なのでなるだけ使わないように検討中です
今までヘルプとにらめっこしていました。
半自動ですがこんなカンジで・・・
後は、本文について先の最終行取得を盛り込んで
ゴニョゴニョしてたら完成出来るかなと思う次第です。
宛先 = Cells(2, 1)
件名 = Cells(2, 2)
本文 = Cells(2, 3)
アドレス = "mailto:" & 宛先 & "?subject=" & 件名 & "&body=" & 本文
With Worksheets(1)
.Hyperlinks.Add Anchor:=.Range("a5"), _
Address:=アドレス, _
ScreenTip:="click", _
TextToDisplay:="送信"
End With
不明点ありましたらもう少し相談に乗っていただきたく
もうすこしお付合いくださいませ。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) 【困っています】VBA 追加処理の記述を教えてください。 1 2022/08/25 22:54
- Visual Basic(VBA) 【困っています2】VBA 追加処理の記述を教えてください。 2 2022/08/26 11:42
- Visual Basic(VBA) Excelのマクロコードについて教えてください。 1 2022/03/27 13:25
- Visual Basic(VBA) VBAでoutlook365が起動しません。 4 2022/08/25 13:31
- Excel(エクセル) Excelのマクロについてご教授ください 2 2023/02/25 09:43
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2022/10/13 08:41
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2022/10/11 12:55
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Excel(エクセル) エクセルのマクロについて教えてください。 2 2023/02/21 13:29
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
パーマネントエラーってなんで...
-
EメールからGメールへ送信方法
-
サンダーバードでエラーメール...
-
最近mailをはじめたら
-
Thunderbird 2.0 "有効なメール...
-
メールが送信できない 発信側で...
-
@ggmail.comで送信してしまいま...
-
[携帯]メールが送信できない[So...
-
メールが通信エラーになる
-
突然メールの送信ができなくな...
-
特定の人からメール受信できない
-
gmailで送信メールに添付した画...
-
メールが送れる時と送れない時...
-
雛形メールの件で
-
メールエラーThe user(s) accou...
-
「その後どうなりましたか?」...
-
アウトルックの受信トレーの赤...
-
Gmailについて
-
サンダーバード送信時に送信フ...
-
「FAX送信票」と「FAX送信表」...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
パーマネントエラーってなんで...
-
EメールからGメールへ送信方法
-
メールエラーThe user(s) accou...
-
メールが送信できない 発信側で...
-
Excelの更新をメール通知
-
最近mailをはじめたら
-
訳して下さい!
-
メールが通信エラーになる
-
hotmailに送るとリターンメールが
-
e-taxで確定申告が送信できてな...
-
[携帯]メールが送信できない[So...
-
Thunderbird 2.0 "有効なメール...
-
サンダーバードでエラーメール...
-
Thunderbirdで添付し送信したPD...
-
特定ドメイン宛にメールが送れ...
-
outlookによる複数メール(10件...
-
メールの送信が出来ない
-
@ybb.ne.jpと@yahoo.co.jp
-
Mail Distributorで困ってます。
-
開封確認メール送信のエラーを...
おすすめ情報