• 締切済み

VBAで複数の添付ファイルを指定してメールを送信する方法を教えてください！

大変困っています。。。 AccessVBAで"bsmtp"というのを使用して複数の添付ファイルを貼付し送信したいです。 現在、添付ファイルを1つであれば送信することができています。 ただし、複数の添付ファイルを指定する方法がわかりません。 参考になるかわかりませんが、メール送信用定義 Private 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 Function P_F_SendMail(ByVal strBody As String, ByVal strAddress_To As String, ByVal strAddress_From As String, _ ByVal strSMTPSvrName As String, Optional ByVal strSubject As String = "", _ Optional ByVal strAttch As String = "") As String P_F_SendMail = SendMail(strSMTPSvrName, strAddress_To, strAddress_From, strSubject, strBody, strAttch) End Function ～～～中略～～～ Do Until RS_File.EOF If Bol_Flg = False Then Bol_Flg = True Else FMAIL_BODY = FMAIL_BODY & vbNewLine FATTCH = FATTCH & vbTab End If FMAIL_BODY = FMAIL_BODY & "<< FILE NAME = " & RS_File.Fields("ファイル名") & ">>" FATTCH = FATTCH & PC_STR_SAVEPATH & RS_File.Fields("ファイル名") RS_File.MoveNext Loop ～以下省略～～ というようなプログラムなのですが、どうか宜しくお願いいたします！

みんなの回答

  • notnot
  • ベストアンサー率47% (4848/10261)
回答No.1

http://www.hi-ho.ne.jp/babaq/linux/bsmtplib.html には、「タブで区切って複数指定できます」と書いてあります。

dosanko45
質問者

お礼

ありがとうございました＾＾ おかげさまで解決いたしました！

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. その他（プログラミング・開発）

関連するQ&A

  • メールの送信について

    ASPを使ってwebアプリ見たいなのを作ろうとしています。 データの登録時に予め登録されてているユーザに登録された旨を伝える メールを送信したいです。 いろいろ試した結果、直でbsap21を呼び出すのではなく、bsmtp.dllを 呼び出して送信するほうが動きがいい（というか、basp21のほうはSMTPサーバに接続しない）ので、その方向で行きたいのですが。。。 見つけたコードが以下です。 ------------------------------------------------------------ Private Declare Function SendMail Lib "bsmtp"_ (strServer As String, strTo As String, strFrom As String, _ strSubject As String, strBody As String, strFile As String) As String Public Function SendViaBASP() As String Dim strMailServer As String: strMailServer = "***.***" Dim strFrom As String: strFrom = "hoge@hoge.com" Dim strTo As String: strTo = "hoge@hoge.com" Dim strBcc As String: strBcc = "" Dim strToBcc As String: strToBcc = "" Dim fHTML As Boolean: fHTML = False Dim strSubject As String Dim strBody As String Dim strAttachments As String: strAttachments = "" Dim strRet As String strSubject = "BASP21" strBody = "このメールは、BASP21経由で送信しました." If Len(strTo) Then strToBcc = strTo Else strToBcc = strBcc End If If fHTML Then strToBcc = ">Content-Type: text/html; charset=iso-2022-jp" _ & vbTab & strToBcc End If strRet = SendMail(strMailServer, _ strToBcc, strFrom, strSubject, strBody, _ strAttachments) SendViaBASP = strRet End Function --------------------------------------------------------------- で、これをACCESSのモジュールに登録し、実行したところ問題なく 動くのですが、これをASPに組み込む方法がわかりません。 ACCESSはデータの登録先ではありますが、常に起動しているわけでは ないので、おそらくモジュールとした場合、動かないですよね？ ASPから上記のコードを動かすには、どうしたらいいでしょうか。 普通にASPの中（<%～%>）に入れると「ステートメントの末尾が不正」 とのメッセージがでてしまいます。 どうかよろしくお願いします。

  • Basp21を使用してメール送信ができない

    Basp21を使用して、メール送信プログラム(Excel VBA)を作成しました。 ５台のパソコン(同一仕様)の内１台のパソコンのみエラーが発生してメール送信ができません。 他の４台のPCと環境の相違は無いと思いますが、原因が解りません。 パソコンの初期化をすれば、正常に動作すると思いますが、 エラー発生の都度、初期化もできません。 どなたか、ご教示をよろしくお願いします。 PC環境 　OS　 ：Win7 Pro　64Bit環境 　Excel：2013 32Bit 　セキュリティソフト：無効 コンポーネントの組み込み 　Bsmtp.dll(587 Version) を C:\Windows\SysWOW64 のフォルダーにコピー エラーメッセージ(1秒程度でリターン) 　HELO BSMTP.DLL helo BSMTP.DLL 確認項目 　1)通常のメール送受信は問題無し(Outlook) 　2)Bsmtpのセキュリティは、正常な他のPCと同じ 　3)Administratorsで実行してもエラー発生(ユーザー権限の問題) 　4)エラー発生時に、Bsmtp.dllの削除操作 　　　Excelによって開かれているため削除不可のメッセージ(dllの読込み確認) 　5)架空のサーバーを指定：Cant connect Server 11001のメッセージ 　6)LANケーブルを抜く　 ：Cant connect Server 11004 　7)Excelの再インストール(レジストリも削除)しても同じ(Excelのチェック) 　8)Bsmtp.dllをコピーしなおしても同じ(Bsmtpのチェック) プログラム 　Private Declare Function SendMail Lib "BSMTP.dll" _ (szServer As String, szTo As String, szFrom As String, _ szSubject As String, szBody As String, szFile As String) As String strSMTP="aaa.co.jp" strPort="25" strTimeOut="60" strToAddr="a123@aaa.co.jp" strFromAddr="b123@aaa.co.jp" strSubj="メールテスト" 　　strBody="本文" strAttach="" strSV_Name = strSMTP & ":" & strPort & ":" & strTimeOut strMailto = strToAddr strMailFrom = strFromAddr strRC = SendMail(strSV_Name, strMailto, strMailFrom, strSubj, _ strBody, strAttach) If strRC <> "" Then MsgBox "エラー発生" & strRC End If 以上 よろしくお願いします

  • VB6で、Bsmtp.dllを使って、メール送信した際、Time Ou

    VB6で、Bsmtp.dllを使って、メール送信した際、Time Outエラーが発生。 So-netのメールサーバーmail.so-net.ne.jpへメール送信していたのですが、最近Time Outエラーで送れなくなってしまいました。 標準モジュールで Public 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 と定義し、 strRet = SendMail(szServer, szTo, szFrom, szSubject, szBody, szFile) で送信しています。 So-netのメールサーバーmail.so-net.ne.jpへ送信する場合、ポート番号５８７を使用するようですが、それが原因なのでしょうか？ Bsmtp.dllのバージョンは、2.7.6.29です。 よろしくお願いします。

  • VBA エクセル メール送信　ハイパーリンクの貼り方

    お世話になります。 首題の通り、エクセルに記述したマクロを使いメールを送りたいのですが、その際に文章の記述にハイパーリンクを張りたいのです。 例えば下記のモジュールですと、文章のBODYの部分には「OKWAVE」とだけ表示されますが、これをクリックすると[http://okwave.jp/]が開くようにしたいのですが、どのように記述すればよろしいのでしょうか？よろしくご指南くださいませ。 Sub test() Dim strBody As String Filename = "ハイパーリンクの貼り方？？？" strBody = "OKWAVE" Set myOL = CreateObject("Outlook.Application") Set myMAIL = myOL.CreateItem(0) With myMAIL .to = "123@123.GOM" .Subject = Filename .body = strBody .display '.send End With Set myMAIL = Nothing Set myOL = Nothing End Sub

  • ネットのファイルをダウンロードする方法を教えてください。

    web上のファイルをダウンロードするには Public Declare Function URLDownloadToFile Lib "urlmon" _ Alias "URLDownloadToFileA" (ByVal pCaller As Long, _ ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long と宣言してURLDownloadToFileを使えばできることがわかりましたが、うまく行かないケースがあります。おそらく通常の右クリックでダウンロードするものではなく、URLを左クリックして行うものだからじゃないかと思います。いいアイディアはないでしょうか？？

  • VBAを使ってファイルを圧縮したい

    こんばんは。 他の方の質問ですが http://oshiete1.goo.ne.jp/qa2405614.html を参考にＶＢＡでエクセルファイルの圧縮に挑戦しています。 しかしうまくいきません。 なのでご教授お願いします。 エクセルの標準モジュールに 下記のコードを載せました。 //////////////////////////////////////////////////////////////////////// 'Option Explicit Private Declare Function Zip Lib "Zip32j" (ByVal hWnd As Integer, ByVal szCmdLine As String, ByVal szOutPut As String, ByVal dwsize As Integer) As Integer Private Declare Function FindWindow Lib "USER32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Sub testZip() 'Zip32 による圧縮 Dim Filename As String Dim strArchiveName As String Dim strCommand As String Dim RC As Long Dim hWnd As Long Dim strOutPut As String * 512 Dim lngSize As Long 'ハンドル取得 hWnd = FindWindow("XLMANI", Application.Caption) 'ファイル名取得 Filename = myDeskTopPath & "\Book1.xls" If Filename = "False" Then Exit Sub Filename = Mid$(Filename, InStrRev(Filename, "\") + 1) strArchiveName = Mid$(Filename, InStrRev(Filename, "\") + 1, InStrRev(Filename, ".") - InStrRev(Filename, "\") - 1) & ".zip" strCommand = "-u " & strArchiveName & " " & Filename lngSize = Len(strOutPut) RC = Zip(hWnd, strCommand, strOutPut, lngSize) 'Debug.Print strOutPut End Sub Function myDeskTopPath() ' 実行時の デスクトップパス取得 Dim MyWSH As Object Set MyWSH = CreateObject("WScript.Shell") myDeskTopPath = MyWSH.SpecialFolders("Desktop") Set MyWSH = Nothing End Function //////////////////////////////////////////////////////////////////////// そして「Zip32j 」がないので http://www.vector.co.jp/soft/win95/util/se062163.html からダウンロードしました。 しかし、 「 RC = Zip(hWnd, strCommand, strOutPut, lngSize)」 の部分で、 「ファイルが見つかりません。 (Error 53)」 になります。 ダウンロードした「zip3j037」はフォルダごとデスクトップに置いています。 ただこれをダウンロードしただけではダメなのでしょうか？ エラーの原因がわかりません。 よろしくお願いします。

  • VBAで画像ファイルをダウンロードしたいけどうまく

    VBAで画像ファイルをダウンロードしたいけどうまく行かない・・・ XPで、オフィス２００３です。 http://officetanaka.net/other/extra/tips01.htm を参考に、画像ファイルをダウンロードする練習をしているのですが "エラーが発生しました"になってしまいます。 標準モジュールに --------------------------------------------------------- Option Explicit Public Declare Function URLDownloadToFile Lib "urlmon" _ Alias "URLDownloadToFileA" (ByVal pCaller As Long, _ ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long Sub Sample() GetImageFile "http://www.officetanaka.net/sample.jpg", "C:\sample.jpg" End Sub Sub GetImageFile(ImgName As String, SaveName As String) Dim SaveFileName As String, DownloadFile As String, Ret As Long Ret = URLDownloadToFile(0, DownloadFile, SaveFileName, 0, 0) If ImgName = "" Then Exit Sub SaveFileName = SaveName DownloadFile = ImgName Ret = URLDownloadToFile(0, DownloadFile, SaveFileName, 0, 0) If Ret = 0 Then MsgBox "ダウンロードできました" Else MsgBox "エラーが発生しました" End If End Sub --------------------------------------------------------- を貼り付けました。 Retが0にならなくてはいけないみたいですが、 自分の場合は、-2147221020になってしまいます。 どう修正すればいいのか教えてください。

  • VB2008 iniファイルの全セクション取得方法

    こんばんわ。iniファイルの全セクションを取得したく、 以下のコードを使うことはわかったのですが、ここから先がVB初心者の為全く解かりません。ボタン１を押したらC:\Test.ini のファイルの全セクションを取得というコードはどのように記入すればよいのでしょうか。 どうぞ宜しくお願いいたします。 Declare Function GetPrivateProfileSectionNames Lib "Kernel32.dll" _ Alias "GetPrivateProfileSectionNamesA" _ (ByVal lpszReturnBuffer As String, ByVal nSize As Long, _ ByVal lpFileName As String) As Long

  • 64ビットエクセルでのAPI宣言/PtrSafe

    エクセルのInputboxで、入力された文字列を自動的にアスタリスクで隠すようにする方法を探し http://okwave.jp/qa/q2371878.html の回答No1のコードがまさに最適なコードで、これまで非常に助かっていました。 ところが、64bitのエクセルでは動かないことがわかりました。 表示されたエラーメッセージの言葉から調べて、PtrSafeという言葉を入れなければならないようなのでAPI宣言を以下のようにしてみました。 #If VBA7 And Win64 Then '64ビット版 Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long #Else '32ビット版 Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long #End If ところが、回答No1のコードで Sub Report_Open()　を実行すると Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _ Optional YPos, Optional HelpFile, Optional Context) As String のところがハイライトされてエラーになります。 どう直せば良いのでしょうか？ 全文のコードを乗せると字数制限に引っかかりますので、申し訳ありませんが宣言以外の部分は http://okwave.jp/qa/q2371878.html の回答No1のコードを見てくださいますようお願いします。

  • EXCEL VBA メール送信でファイル添付

    現在、使用しているVBAを利用したメンバー向け案内メール配信で、ファイルを添付できないかと考えております。 G列に入力したアドレスのファイルを添付して送信できればと思うのですが、ご教授願えませんでしょうか。 現在のVBAは企業名、宛先共に変えられるように下記のような形となっております。 添付ファイルも宛先毎に異なります。 B列：送信先メールアドレス C列：メール件名 D列：送信先所属名 E列：送信先宛名 F列：メール本文 コマンドボタンで一括配信となっております。 【以下記述】 Sub 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 .Update End With ' 送信範囲設定 LastRow = Worksheets("Sheet1").Range("B7").End(xlDown).Row ' メール送信ループ For i = 8 To LastRow ' 送信状況メッセージクリア Worksheets("Sheet1").Range("F2").Value = "" ' メール本文作成 strbody = Worksheets("Sheet1").Range("D" & i).Value & vbCrLf & "　" & _ Worksheets("Sheet1").Range("E" & i).Value & "　様" & vbCrLf & vbCrLf & _ 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 .TextBody = strbody .Send End With ' 送信状況メッセージ更新 Worksheets("Sheet1").Range("F2").Value = Worksheets("Sheet1").Range("B" & i).Value & " まで送信成功！" ' ３秒停止 Application.Wait [ NOW() + "0:00:03" ] Next i End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する