| |
marai さん、かみちゃんさん、こんにちはあゆたろうです。
私の書き込み後に、marai さんが、
今回は、取り急ぎの仕事でした･･･これを気にVBAを・・・。
みたいな書き込みがあり、他の識者からの書き込みがあり、そのコードを私の勉強の素材にする。
って思ってたのに...。(*^_^*)冗談です。
かみちゃんさんのご紹介の
URLは様式が見慣れてないのか上級者が向けなのかチョット見づらかったですが、参考になりました。
解ったこと・SendMailは慎重にやるべし！
覚えたこと・.RcvMailが出来る環境にすれば、今回掲示するコードの次の段階が出来る。
思ったこと・かみちゃんさんのわたしへのヒント （わたしは自分に良いように考える人ですから(^・^)）
本題
ブック名 "緊急連絡先リスト.xls"
所属|氏名|12月29日|12月30日|12月31日|1月1日|1月2日|1月3日|1月4日|1月5日|1月6日|電話
1回目|maraiさん|
1回目|maraiさん知り合い|
2回目|maraiさん|
2回目|maraiさん知り合い|
−−−−−− シート名"調査表" −−−−−−
所属|氏名|12月29日|12月30日|12月31日|1月1日|1月2日|1月3日|1月4日|1月5日|1月6日|電話
−−−−−− シート名"送信フォーム" −−−−−−
と、どこかに専用のフォルダーを作成し、（今回は"D:\エクセル\緊急連絡先Ｗｅｂ\"としました。）
Sub メール送信()
Dim r As Long '65536かな？
Dim tSy As String '所属名
Dim tNa As Range 'メール送信対象者
Dim Fna As String '送信ファイル名
Dim i As Long '分割用
Windows("緊急連絡先リスト.xls").Activate
Sheets("調査表").Select
'最終行にコメント
r = Worksheets("調査表").Rows.Count
Cells(r, 2).End(xlUp).Rows.Offset(1) = "以上です"
Set tNa = Range("B2")
i = 1
Do
If tNa.Offset(0, 12).Value <> "送信済み" Then
Fna = tNa & "殿緊急連絡調査.xls"
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="D:\エクセル\緊急連絡先Ｗｅｂ\" & Fna
Windows("緊急連絡先リスト.xls").Activate
Sheets("送信ホーム").Select
Sheets("送信ホーム").Copy Before:=Workbooks(Fna).Sheets(1)
Workbooks(Fna).Activate
Sheets(1).Range("B2") = tNa '名前転記
Sheets(1).Range("A2") = tNa.Offset(0, -1) '所属転記
ActiveWorkbook.SendMail (tNa.Value)
Application.DisplayAlerts = False '警告メッセージ非表示
Workbooks(Fna).Save '上書き保存
Workbooks(Fna).Close '閉Zil
Application.DisplayAlerts = True '警告メッセージ表示
tNa.Offset(0, 12).Value = "送信済み"
i = i + 1
If i = 3 Then
MsgBox "一度メールボックス容量確認の為終了"
Exit Sub
End If
End If
Set tNa = tNa.Offset(1)
Loop Until tNa.Value = "以上です"
End Sub
を走らせる。
If i = 3 Then の部分は、行けるとこまで増やしてください。
サーバーイジメと個人メールボックスサイズの対策のつもりです。
多分大丈夫かと思いますが、maraiさんと隣の人とかに試しでやってみてください。
でも、ある程度のレベルの人からみたら幼稚なコードだと思います。
ダメだったら誰かからアドバイスがあると思います。きっと
ps.なんか表が上手く貼り付けれませんが…。| で仕切ってください。
『以上です』って名前の人はいないですよね？
|
|
あゆたろう
- 07/12/5(水) 15:20 -
