Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


49407 / 76732 ←次へ | 前へ→

【32235】メール送信で ccを実現したい
質問  row  - 05/12/10(土) 23:16 -

引用なし
パスワード
   仕事上で、メール送信をする必要があり
このサイト(http://www.hi-ho.ne.jp/babaq/basp21.html
にて、BASP21で送信するマクロを作成しました。

しかし、宛先とCCの両方を指定して
複数送信したいのです。

具体的には、部長   は 宛先
      課長や係長は CC
という感じです。

思考の渦に巻き込まれて先に、進めなくなりましたので
どなたか教えてください。

以下が、私の作成したマクロです。
BASP21のマクロから若干変更してあります
-----------------------------------------------------------------------

  Dim ret As String
  Dim szLogfile As String
  Dim szServer As String, szTo As String, szFrom As String
  Dim szSubject As String, szBody As String, szFile As String
  Dim flBody
  Dim i As Long
  Dim fs, a As Object
  Dim 宛先人数 As Variant
  宛先人数 = Worksheets(1).Cells(1, 5)
  Dim j As Variant
  For j = 1 To 宛先人数
   Worksheets(1).Cells(2 + j, 1) = "○"
  Next j


On Error GoTo Err_Handler
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set a = fs.CreateTextFile(Worksheets("本文").Cells(15, 1), True)
  
  
  ' メール送信結果を記録するファイル名を指定します。
  szServer = Worksheets("本文").Cells(11, 1) ' SMTPサーバ名
  '
  With Worksheets("宛名及び置換文字")
  If .Cells(1, 3) & .Cells(1, 7) = "" Then
    MsgBox "タイトルとFROMを入力してください"
    GoTo Exit_sub
  Else
    If MsgBox("タイトル:" & .Cells(1, 3) & "、送信元" & .Cells(1, 7) & "で良いですか?", _
      vbOKCancel, "確認") = vbCancel Then
      GoTo Exit_sub
    End If
  End If
  szSubject = .Cells(1, 3)  ' 件名
  szFrom = .Cells(1, 7)  ' 送信元
  szTo = .Cells(3, 5)  ' 宛先
  If 宛先人数 > 1 Then  ' cc アドレスがある場合は、それを 作成する
     For i = 3 To 宛先人数
      If .Cells(i, 1) = "○" Then
        szTo = szTo & vbTab & "cc" & vbTab & .Cells(i, 5)  ' 宛先
      End If
     Next i
  End If         ' cc アドレス作成終了
  MsgBox szTo
  GoTo owari99
  szBody = .Cells(3, 6) ' 本文
  szFile = .Cells(3, 11) '添付ファイル
  ret = SendMail(szServer, szTo, szFrom, szSubject, szBody, szFile)
  If Len(ret) <> 0 Then
    a.WriteLine (Date & " " & Time & " " & ret & "−" & szTo & "−" & szBody)
    'MsgBox "エラー" & ret & "−" & .Cells(i, 4)
    .Cells(3, 1) = "エラー"
    Else
    .Cells(3, 1) = "完了"
  End If
End With
  ' パラメータエラーのときは、戻り値にエラーメッセージが返ります。
  
  MsgBox "終了"
  GoTo Exit_sub

Err_Handler:
  MsgBox Err.Description, vbCritical, "Error"
  GoTo Exit_sub

Exit_sub:
  a.Close

owari99:

2 hits

【32235】メール送信で ccを実現したい row 05/12/10(土) 23:16 質問
【32236】Re:メール送信で ccを実現したい かみちゃん 05/12/10(土) 23:25 回答
【32237】Re:メール送信で ccを実現したい row 05/12/11(日) 0:30 発言
【32240】Re:メール送信で ccを実現したい かみちゃん 05/12/11(日) 0:52 発言
【32255】Re:メール送信で ccを実現したい row 05/12/11(日) 18:55 発言
【32260】Re:メール送信で ccを実現したい かみちゃん 05/12/11(日) 22:09 発言
【32270】Re:メール送信で ccを実現したい row 05/12/12(月) 0:27 発言
【32274】Re:メール送信で ccを実現したい かみちゃん 05/12/12(月) 7:24 発言
【32396】Re:メール送信で ccを実現したい row 05/12/14(水) 0:58 発言

49407 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free