• ベストアンサー

Thunderbirdでファイル添付出来ません

Excel請求書から出力したPDFファイルをメールソフトのThunderbirdでメールに添付して送信したいのですが、 添付ファイルのパスが間違っているのか「***.pdfファイルが存在しないためメッセージに添付できませんでした。」とエラーになってしまいます。 PDFファイル出力は問題無く出来ており、メール自体は作成できるところまでは出来ているのですが、肝心のファイル添付が出来なくて困っております、どなたかお助け願えませんでしょうか。 ※PDFファイルの保存場所は任意に選択⇒ファイル名は顧客名で都度出力される形になってます。 Sub PDF出力メール送信テスト用() Dim fname As String Dim pdfname1 As String Dim pdfname2 As String Dim rtn As Long Dim wsh As Object If MsgBox("PDFをメール送信する場合はOK、送信しない、または間違ってこのボタンをクリックした場合はキャンセルをクリックしてください。", vbOKCancel) = vbCancel Then End End If 'pdfname1は会社名、pdfname2は部署名、両方足して『顧客名.pdf』になるようにしています pdfname1 = Range("a4").Text pdfname2 = Range("a5").Text '保存ファイル名及び保存場所の設定 fname = Application.GetSaveAsFilename("【御請求書】" & pdfname1 & " " & pdfname2 & " 御中", "PDFファイル,*.pdf") 'キャンセルボタン押下時 If fname = "False" Then Exit Sub 'ファイルの存在確認 If Dir(fname) <> "" Then rtn = MsgBox(fname & " が存在します。上書きしますか?", vbOKCancel + vbQuestion, "確認") 'キャンセルボタン押下時 If rtn = vbCancel Then Exit Sub End If '印刷順にシートを並び替え Worksheets("請求書").Move Before:=Worksheets("請求書ひな形") Worksheets("請求書").Select Worksheets("請求書ひな形").Select False Worksheets("請求書ひな形").Activate ' 請求書PDF出力 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fname MsgBox fname & " 出力完了" '元通りにシートを並び替え Worksheets("請求書ひな形").Move Before:=Worksheets("請求書") Worksheets("請求書ひな形").Select Dim sPath As String Dim mailTo As String Dim subject As String Dim preface As String Dim mailBody As String Dim attachPath As String sPath = """C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe"" -compose " '送信先アドレスはExcelのx1セルに反映 mailTo = Range("x1").Value subject = "御請求書の送付について" preface = pdfname1 & pdfname2 & " 御中" & vbNewLine & vbNewLine & "いつもお世話になります。" & vbNewLine & "御請求書をお送り致しますのでご確認下さい。" & vbNewLine & vbNewLine & "以上、宜しくお願い致します。" mailBody = preface '添付ファイルのパスはfnameではダメなんでしょうか? attachPath = fname Shell sPath & "to=" & mailTo & ",subject=" & subject & ",body=" & mailBody & "," & "attachment=" & attachPath End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • dell_OK
  • ベストアンサー率13% (740/5646)
回答No.1

試してみたところ、添付されたり、されなかったりしました。 いろいろ試してみてわかったことは、ファイル名が「【御請求書】 御中.pdf」の時に添付されませんでした。 シートは「請求書」と「請求書ひながた」以外にあるのかどうかわかりませんが、マクロ実行時に選択されているシートのセルA4とセルA5の両方が空の時に、上記ファイル名となり、添付できませんでした。 私の環境でのテストなのでいろいろと違う点があるかと思いますが、両セルに会社名、部署名が入っていないシートが選択された状態で実行されているのかと思ったりしています。 だとしたら、対象となるシートをマクロ実行前に選択しておくか、マクロで自動選択するようにする必要がありそうです。

Soriani52
質問者

お礼

ご回答ありがとうございます! セルA4は空、セルA5は会社名入りのテストファイルで何度も試しており、昨日は何度やっても添付出来きなかったのですが、本日質問欄に貼り付けたVBAを再度貼りなおしてテストしましたところ無事添付出来るようになりました! 片側のみに名前有り、また両方のセルに名前有りどちらも無事に添付出来ましたが、ご指摘の通り両方が空の場合は添付出来ませんでした。 基本的に出力する場合は会社名無しということはありませんので、この内容で実用に入りたいと思っております。昨日どうして添付できなかったのか不思議なのですが色々さわってどこかおかしくなったもので何度もテストしていただけなのかもしれません・・。 お恥ずかしい質問にご対応いただき感謝しております、ありがとうございました。

関連するQ&A

  • ファイル名を合成すると検索できないのでしょうか?

    下記のような式がありまして、一度作成したファイルは上書きされないはずですが何回やっても上書きされてしまいます。 これはファイルを検索していないのでしょうか? 既にファイルがあったら終了するはずですが何か間違えていますか? 'ファイル作成 Sub MakeCopyFile(newfile As String, orgfile As String) If SearchFile(newfile) Then Exit Sub End If Set fs = CreateObject("Scripting.FileSystemObject") fs.CopyFile orgfile, newfile End Sub ' ファイル検索 Function SearchFile(fname As String) As Boolean SearchFile = False Set fs = Application.FileSearch With fs .Filename = fname If .Execute() > 0 Then SearchFile = True End If End With End Function Sub Macro1() Dim name As String '名前 Dim fname As String 'ファイル名 Dim directory As String '作成先ディレクトリ Dim fullpath As String 'フルパス Dim orgfile As String '雛形のファイル名 Dim editbook As Workbook '個人データブック Dim id As String '番号 directory = "H:\test\" orgfile = "H:\test\雛形.xls" For i = 1 To 100 name = ThisWorkbook.Worksheets("Sheet2").Cells(i, 10).Value id = ThisWorkbook.Worksheets("Sheet2").Cells(i, 12).Value If name = "" Then Exit For End If 'コピーしたファイルを作成する fname = name + id + ".xls" 'ファイル名合成 fullpath = directory + fname 'フルパス合成 Call MakeCopyFile(fullpath, orgfile) 'ファイル作成 Workbooks.Open Filename:=fullpath Set editbook = Workbooks(fname) editbook.Worksheets("Sheet3").Cells(8, 14).Value = name editbook.Worksheets("Sheet3").Cells(8, 10).Value = id '※(その他必要な処理があれば追加してください) editbook.Close (True) Next i End Sub

  • pdf印刷時に登録ファイル名の確認を無効化したい

    excel2010 TESTフォルダ内にある。全てのexcelフィルをcutepdfwriterでpdfファイル化しようとしています。 マクロ Sub test() Application.DisplayAlerts = False Dim Fol As String Dim Fname As String Dim Ws As Worksheet Fol = "C:\test" Fname = Dir(Fol & "\*.xlsm") Do While Fname <> "" If Fname <> ThisWorkbook.Name Then Workbooks.Open Fol & "\" & Fname For Each Ws In Worksheets Ws.PrintOut Next Workbooks(Fname).Close SaveChanges:=False End If Fname = Dir() Loop End Sub で実施するとファイルを開いてpdfファイルを作成可能なのですが、 各々のファイルに対して、名前をつけて保存 ファイル名.pdf と聞いてきます。 その都度、保存というボタンをクリックする必要があり、 大量のファイル実施時、手間です。 なお、cutepdfwriterを通常使うプリンタに設定しています。 この保存というボタンをクリックしないで、ファイル名をそのままでpdfファイル化する方法は、 ありますでしょうか?

  • 複数ファイルの1つのシート中の総行数を求めるには

    大変お世話になっております。 複数ファイルの1つのシート(カテーログ)中の最終行数を求めるのに、下記のマクロを書いて実行しましたが、エラーは出ませんが総行数など、何も反応がありません。なにも出力しない原因がお分かりでしたら、ご教示頂けると大変たすかります。まだまだマクロは超初心者です。 出力したい情報は、ファイル名とA列の3行目~最終行の総行数です。 Sub データ総行数求め() Dim fpath As String, fname As String Dim wb As Workbook, ws As Worksheet Dim crow As Long, cnt As Long fpath = "C:\Users\Owner\Documents\連結作業\202304-202309\)" fname = Dir(fpath & "*.xlsx") Set ws = ThisWorkbook.Worksheets("test") crow = 1 Do Until (fname = "") Set wb = Workbooks.Open(fpath & fname) If (sheet_chk(wb, "カテーログ") = True) Then cnt = count_row(wb.Worksheets("カテーログ")) Worksheets("カテーログ").Range("A3").Value ws.Cells(crow, 1).Value = fname ws.Cells(crow, 2).Value = "カテーログ" ws.Cells(crow, 3).Value = cnt crow = crow + 1 End If wb.Close fname = Dir() Loop End Sub '戻り値の定義 Function count_row(ByVal ws As Worksheet) As Long Dim k As Long, tmp As Long count_row = 0 For k = 1 To 256 tmp = ws.Cells(ws.Rows.Count, k).End(xlUp).Row If (tmp > count_row) Then count_row = tmp Next End Function Function sheet_chk(ByVal wb As Workbook, ByVal msg As String) As Boolean Dim w As Worksheet sheet_chk = False For Each w In wb.Worksheets If (w.Name = msg) Then sheet_chk = True Exit For End If Next End Function

  • VBAのデバックをどうかお助けください。

    ネットなどで調べたコードをつなぎ合わせ、なんとか下記のようなコードを作成しました。 Sub TEST2() ActiveSheet.Protect UserInterfaceOnly:=True Dim fname As String fname = Range("C3").Text ActiveSheet.Select ActiveSheet.Copy Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False Range("A1").Select ActiveWorkbook.SaveAs _ Filename:="C:\Documents and Settings\***\My Documents\ファイル\" & fname & ".xls", FileFormat:=xlNormal Dim MailSmtpServer As String Dim MailFrom As String Dim MailTo As String Dim MailSubject As String Dim MailBody As String Dim MailAddFile As Variant Dim strMSG As String ' 添付ファイルの選択 MailAddFile = "C:\Documents and Settings\***\My Documents\ファイル\" & fname & ".xls" ' 送信確認 If MsgBox("メールを送信します。" & vbCr & _ "SMTP,発信者,宛先等は正しいですか?", vbYesNo) <> vbYes Then Exit Sub MailSmtpServer = "mail.***.co.jp" ' SMTPサーバ MailFrom = "***@***.co.jp" ' 発信者 MailTo = "***@***.co.jp" ' 宛先 MailSubject = fname ' 件名 MailBody = "" ' 本文 ' メール送信(CC,BCCはブランク) strMSG = SendMailByCDO(MailSmtpServer, MailFrom, MailTo, "", "", _ MailSubject, MailBody, MailAddFile) ' 文字コードを任意に指定する場合は以下のようにします。 ' strMSG = SendMailByCDO(MailSmtpServer, MailFrom, MailTo, "", "", _ MailSubject, MailBody, MailAddFile, cdoISO_2022_JP) If strMSG <> "OK" Then MsgBox Mid(strMSG, 3) End Sub しかし、このようなエラーがでました。’宛先等は正しいですか?’のメッセージのあとです。 ’2147024864プロセスはファイルにアクセスできません’。 ところで私がやりたいことは、(1)作成したエクセルの("C3").Textをファイル名にして、アクティブシートを(値のみ貼り付けして)保存し、(2)その作成されたファイルを添付してメールで送付する。ということです。 (2)のどこかで失敗しているものと思われますが、どこを直したらいいのかわかりません。 ここまで自分でできただけでも奇跡的なので、これ以上、どうしてよいか全くわからず。。 不足の情報があれば補足いたしますのでどうぞお願いいたします。

  • 【ExcelVBA】IEの一時ファイルと履歴の削除

    こんにちわ。 先日、こちらでExcel VBAを用いてCookieを削除する方法をご教授いただきました。 http://okwave.jp/qa/q7951325.html 今回、Cookie以外にインターネット一時ファイルと履歴を削除するため、以下のロジックを組んだのですが、どちらとも削除できませんでした。 WinXPで一時ファイルを削除しようとすると「書き込みできませんでした」とエラーがでます。 また、DeleteUrlCacheEntryでも削除できませんでした。 お忙しいところ大変申し訳ありませんが、インターネット一時ファイルと履歴を削除する方法をご教授いただけないでしょうか? ====================================================================== Private Sub 一時ファイル削除(Byval psKbn) Dim oFolder As Object Dim sPath As String Dim lRs As Long ' 一時ファイル、履歴が保存されているフォルダのパスを取得 sPath = String(260, vbNullChar) If psKbn = "1" Then ' 一時ファイル lRs = SHGetFolderPath(0, &H20, 0, 0, sPath) Else ' 履歴 lRs = SHGetFolderPath(0, &H22, 0, 0, sPath) End If If lRs = &H0 Then sPath = Left(sPath, InStr(1, sPath, Chr(0)) - 1) Set oFolder = CreateObject("Scripting.FileSystemObject") Call oFolder.DeleteFile(sPath & "\*.*") End If Set oFolder = Nothing End Sub ====================================================================== 以上です。 ++++++++++++++++++++ 【環境】 OS:WinXP 以上 ブラウザ:IE7 以上 Excel:Excel2007 以上 ++++++++++++++++++++

  • VBAにて複数フォルダのエクセルファイルからデータ抽出を行いたいのですが…

    現在、下記の方法で複数のブックからデータを抽出し、 一覧表示をしています。(一覧表示をしているブックを仮にAとします。) 今のままだと、同一フォルダ内のブックしか抽出されません。 これを、サブフォルダまで対象にするには、どうすれば良いのでしょうか? 簡単に例をあげると、 フォルダ(1)の中にAを入れておいて フォルダ(1)の下にあるサブフォルダ(1)、サブフォルダ(2)の中にあるブックからデータの抽出を行いたいのです。 現在つかっているVBAは Sub 抽出用() Dim FName As String Dim Folder As String Dim wb As Workbook Dim i As Integer, j As Integer Application.ScreenUpdating = False Folder = ThisWorkbook.Path & "\" i = 1: j = 1 Worksheets(1).Cells.ClearContents FName = Dir(Folder & "*.xls") Do While FName <> "" If FName <> ThisWorkbook.Name Then Workbooks.Open (Folder & FName) Workbooks(Workbooks.Count).Worksheets(5).Rows("1:1").Copy _ ThisWorkbook.Worksheets(5).Cells(i + 3, 1) Workbooks(Workbooks.Count).Close Application.StatusBar = j & "ファイル処理済み" i = i + 1: j = j + 1 End If FName = Dir() Loop Application.StatusBar = "" Application.ScreenUpdating = True MsgBox ("完了しました") End Sub です。 いいお知恵があれば、よろしくお願い致します。

  • ExcelVBAで添付ファイルをつけたいです。

    Excelで顧客のアドレス帳を作成しており、そのアドレス帳全員に同じ文面でメールを送信したいと思い、マクロを作成しております。 調べながらここまではきたのですが、添付ファイルが着きません。 お手数ですが、どなたか自身のデスクトップ上にあるフォルダ内のPDFを 全メールに添付する方法を教えて頂けますでしょうか。 実行しようとすると「添付できるのは、ファイルかオブジェクトに限られます。」と出てしまいます。 ご教示の程、宜しくお願い致します。 下記書いたコードです。 Sub 自動送信Sample() Dim OL As Outlook.Application Dim MI As Outlook.MailItem Dim R_Start As Integer, R_End As Integer Dim Tenp1 As String, Tenp2 As String Set OL = CreateObject("Outlook.Application") Tenp1 = Worksheets("Sheet1").Range("B4") '添付1 Tenp2 = Worksheets("Sheet1").Range("B5") '添付2 R_Start = Worksheets("Sheet1").Range("G2") + 7 '開始番号(開始行) R_End = Worksheets("Sheet1").Range("I2") + 7 '終了番号(終了行) For R_Start = R_Start To R_End Set MI = OL.CreateItem(olMailItem) MI.SentOnBehalfOfName = Worksheets("Sheet1").Range("B2") '差出人 MI.Subject = Worksheets("Sheet1").Range("B3") '件名 MI.To = Worksheets("Sheet1").Cells(R_Start, "B") 'To MI.CC = Worksheets("Sheet1").Cells(R_Start, "C") 'CC MI.BCC = Worksheets("Sheet1").Cells(R_Start, "D") 'BCC '添付 If Tenp1 <> "" Then MI.Attachments.Add Tenp1 End If If Tenp2 <> "" Then MI.Attachments.Add Tenp2 End If '本文 MI.Body = Worksheets("Sheet1").Cells(R_Start, "E") & vbCr _ & Worksheets("Sheet1").Cells(R_Start, "F") & vbCr & vbCr _ & Worksheets("Sheet2").Range("A3") MI.Display 'メール表示 Next Set OL = Nothing Set MI = Nothing MsgBox "完了!" End Sub

  • 画像ファイル名をパス付きで表示

    Sub Test2() Dim objFSO As Object Dim sPath As String, sSubFol As String, sFileName As String Dim nRow As Long, nCol As Long Set objFSO = CreateObject("Scripting.FileSystemObject") sPath = "C:\Users\Owner\Downloads\base\setting_000002016\" nRow = 2 sSubFol = Cells(nRow, 1).Text Do While sSubFol <> "" nCol = 11 sFileName = Dir(sPath & sSubFol & "\*.jpg") If objFSO.FileExists(sPath & sSubFol & "\" & sSubFol & ".jpg") Then nCol = 12 Else nCol = 11 End If Do While sFileName <> "" If sFileName = sSubFol & ".jpg" Then Cells(nRow, 11) = sFileName Else Cells(nRow, nCol) = sFileName nCol = nCol + 1 End If sFileName = Dir() Loop nRow = nRow + 1 sSubFol = Cells(nRow, 1).Text Loop Set objFSO = Nothing End Sub こちらは商品番号とサブフォルダの名前が一致したらフォルダ内のファイル名を抽出するというマクロですが、これをパス付で表示という動作をするにはどこをいじればよろしいでしょうか?

  • Excel2003で動いたVisualが2007では?

    Excel2003で作った下記のVisual Basicが2007では、最初にクリックしたところには行かず いつも同じ位置に挿入されます。 出来ればセルF1の位置に挿入したいのですが Sub macro1() Dim Fname As String Dim FLT As String Dim Sheetmei As String FLT = "JPEGファイル(*.jpg),*.jpg" Fname = Application.GetOpenFilename(FLT, 2, "開く", True) If Fname = "False" Then Exit Sub End If Sheetmei = Worksheets(1).Name ActiveSheet.Pictures.Insert(Fname).Select Call Jpeg_size_adjust End Sub サブで下記も有ります Sub Jpeg_size_adjust() Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.Height = 270.75 Selection.ShapeRange.Width = 360

  • Excel VBA:ダイアログを使ってファイル名を取得したい

    ファイルを開く際に、GetOpenFilenameを使用し、以下のように記述しています。 Dim sFName As String Dim sPath As String sPath = ThisWorkbook.Path & "\データフォルダ" ChDir sPath sFName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", MultiSelect:=False) このとき、win98ですと、指定したフォルダが表示されますが、 win2000やXPですと、Excelのカレントフォルダが表示されます。 ダイアログ表示したときに、任意のフォルダを表示させるには、どのようにしたらよいですか? ご回答よろしくお願いします。

専門家に質問してみよう