VBAを初めて触る者です。 Excelデータ→請求書→PDF→メール添付一括送信マクロ 上記のようなシステムを作りたく以前質問を致しました。

VBAを初めて触る者です。 Excelデータ→請求書→PDF→メール添付一括送信マクロ 上記のようなシステムを作りたく以前質問を致しました。 ※参考サイトhttps://www.ex-it-blog.com/Excel-invoice-pdf-mail-macro 少し改良を加えたいと思い、試しているのですがうまくいきません。 やりたい内容が、上記の流れの最初に「同じフォルダ内にあるcsvファイルのシート1をコピーし、Excelデータにペーストする」を入れたいのです。 csvファイルのA1からC3までコピーして、ExcelデータのA2からC4にペーストするコードを調べて書いてみましたが、このまま実行すると「アプリケーション定義またはオブジェクト定義のエラーです。」とエラーになります。 また、PDF化されず新しいブックが作成されて処理が止まります。 詳しい方、教えていただいてもよろしいでしょうか? よろしくお願いいたします。 Sub invoice_mail() Dim wb1 As Workbook Workbooks.Open ThisWorkbook.Path & "\test.csv" Set wb1 = ActiveWorkbook wb1.Worksheets(1).Range("A1:C3").Copy Destination:=ThisWorkbook.Worksheets(1).Range("A2:C4") Application.DisplayAlerts = False wb1.Close Application.DisplayAlerts = True '■請求書Excelの作成 'データのカウント Dim Max_row As Long Max_row = Worksheets("data").Range("A" & Rows.Count).End(xlUp).Row 'シート「データ」を変数へ Dim W_Data As Worksheet Set W_Data = ThisWorkbook.Worksheets("data") Dim i As Long For i = 2 To Max_row '請求書フォーマットを新しいブックへコピー ThisWorkbook.Activate Worksheets("invoice").Copy ActiveSheet.Range("d5").Value = Date '日付 ActiveSheet.Range("a6").Value = W_Data.Range("a" & i).Value & "様" '氏名 ActiveSheet.Range("b8").Value = W_Data.Range("b" & i).Value '項目 ActiveSheet.Range("b16").Value = W_Data.Range("c" & i).Value '金額 ActiveSheet.Name = W_Data.Range("a" & i).Value 'シート名 '■請求書PDFの作成 'ファイル名 Dim Pdf_name Pdf_name = ThisWorkbook.Path & "\" & Format(Date, "yyyymmdd") & ActiveSheet.Name & i & "様 請求書.pdf" 'PDFで保存 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pdf_name ActiveWorkbook.Close savechanges:=False '■メール送信 Dim Mail As Object Set Mail = CreateObject("CDO.Message") Dim URL URL = "http://schemas.microsoft.com/cdo/configuration/" 'メールの設定 With Mail.Configuration.Fields .Item(URL & "send" & "using") = 2 .Item(URL & "smtp" & "authenticate") = 1 .Item(URL & "smtp" & "usessl") = 1 .Item(URL & "smtp" & "server") = Worksheets("set").Range("b1").Value 'SMTPサーバー .Item(URL & "smtp" & "serverport") = Worksheets("set").Range("b2").Value 'ポート名 .Item(URL & "send" & "username") = Worksheets("set").Range("b3").Value 'ユーザーID .Item(URL & "send" & "password") = Worksheets("set").Range("b4").Value 'パスワード .Update End With Mail.From = Worksheets("set").Range("b5").Value '送信元 Mail.To = W_Data.Range("d" & i).Value '送信先(シート「data」より) Mail.Subject = Worksheets("set").Range("b6").Value '件名 Dim Body_Name '本文用に姓のみ抽出 Body_Name = W_Data.Range("a" & i).Value Mail.TextBody = Body_Name & Worksheets("set").Range("b7").Value '本文 Mail.AddAttachment Pdf_name '添付ファイル Mail.send 'メール送信 Set Mail = Nothing '設定リセット Next End Sub

Visual Basic49閲覧

ベストアンサー

0

ID非公開

2020/9/18 6:31

変数は最初にまとめて書く方がいいです。 複数ブックを扱う時は、どのブックのどのシートなのかを変数に入れて明示すると間違いないです。(Activeはなるべく使わない) メール送信は環境が違うのでテスト出来ませんので、そのままです。 Sub test() Dim wb1 As Workbook Dim W_Data As Worksheet Dim sh As Worksheet Dim Max_row As Long Dim i As Long Dim Pdf_name As String Dim Mail As Object Dim URL As String Application.ScreenUpdating = False Application.DisplayAlerts = False Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\test.csv") wb1.Worksheets(1).Range("A1:C3").Copy Destination:=ThisWorkbook.Worksheets(1).Range("A2") wb1.Close '請求書Excelの作成 Set W_Data = ThisWorkbook.Worksheets("data") With W_Data Max_row = .Range("A" & Rows.Count).End(xlUp).Row For i = 2 To Max_row '請求書フォーマットを新しいブックへコピー Worksheets("invoice").Copy Set wb1 = ActiveWorkbook Set sh = wb1.Worksheets(1) sh.Range("D5") = Date sh.Range("A6") = .Range("A" & i) & "様" sh.Range("B8") = .Range("B" & i) sh.Range("B16") = .Range("C" & i) '請求書PDFの作成 Pdf_name = ThisWorkbook.Path & "\" & Format(Date, "yyyymmdd") & .Range("A" & i) & i & "様 請求書.pdf" sh.ExportAsFixedFormat Type:=xlTypePDF, fileName:=Pdf_name ActiveWorkbook.Close 'メール送信 Set Mail = CreateObject("CDO.Message") URL = "http://schemas.microsoft.com/cdo/configuration/" 'メールの設定 With Mail.Configuration.Fields .Item(URL & "send" & "using") = 2 .Item(URL & "smtp" & "authenticate") = 1 .Item(URL & "smtp" & "usessl") = 1 .Item(URL & "smtp" & "server") = Worksheets("set").Range("b1").Value 'SMTPサーバー .Item(URL & "smtp" & "serverport") = Worksheets("set").Range("b2").Value 'ポート名 .Item(URL & "send" & "username") = Worksheets("set").Range("b3").Value 'ユーザーID .Item(URL & "send" & "password") = Worksheets("set").Range("b4").Value 'パスワード .Update End With Mail.From = Worksheets("set").Range("b5").Value '送信元 Mail.To = W_Data.Range("d" & i).Value '送信先(シート「data」より) Mail.Subject = Worksheets("set").Range("b6").Value '件名 Dim Body_Name '本文用に姓のみ抽出 Body_Name = W_Data.Range("a" & i).Value Mail.TextBody = Body_Name & Worksheets("set").Range("b7").Value '本文 Mail.AddAttachment Pdf_name '添付ファイル Mail.send 'メール送信 Set Mail = Nothing '設定リセット Next i End With Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

ThanksImg質問者からのお礼コメント

ありがとうございました。 原因は、DBから引っ張ってきたデータの後ろにたくさんのスペースが入ってしまっていて、PDFにするときに文字数が入りきらないというのが原因でした。 親切にご回答いただき大変感謝いたします。 ありがとうございました。

お礼日時:9/28 9:05