マクロのコードの追加について教えてください。

Question

下記のコードがあります このコードはシート№２のシート名が「提出シート」の一部のみをExcelファイルにて保存出来るコードです。 このExcelファイルを添付ファイルとしてOutlookのメールで送る方法を教えてください。 
Sub Sub メール送信() Dim mainB As Workbook Set mainB = ThisWorkbook Call シートをコピー2(mainB) End Sub Sub シートをコピー2(MB As Workbook) Dim WB As Workbook Dim WS As Worksheet MB.Sheets(2).Columns("B:AD").Copy Workbooks.Add Set WB = ActiveWorkbook Set WS = WB.Sheets(1) With WS .Range("B1").Select ActiveSheet.Paste .Range("B1:AD195").Copy .Range("B1").PasteSpecial Paste:=xlPasteValues .Rows("49:136").Delete End With With Application.Dialogs(xlDialogSaveAs) .Show Arg1:=MB.Sheets(2).Range("P1").Value End With End Sub 
シート名が「提出シート」に 下記のセル値があります。 
１．送信先 は４名になります。 
１の送信先はセルAE2値 
２の送信先はセルAE3値 
３の送信先はセルAE4値 
４の送信先はセルAE5値です、１の送信先を代表にして残りの２～４迄をCCでも構いません。 
２．件名 セル値P1値でお願いします。 
３．本文 「お世話になっております。」 
「受付担当者様」
 「受付シートをお送りいたします。」
 「ご確認をよろしくお願いいたします。」 の４行でお願いいたします。 何卒よろしくお願いいたします。
非常に困ってます。
具体的なコードをおねがいいたします。

mygoonickname · Accepted Answer

シートをコピー2の　Dim ws　As Worksheet　と
下の方で同じく　Dim ws　As Worksheet　が　同じ変数で宣言している
ため、添付のエラーが出ています。

シートをコピー2の　ws　の変数を、エラーの出ている行以降で使わない
なら、エラーの行を削除しても構いません。Dim ws As Worksheet を消す

もし使うなら、Dim ws As Worksheet　のwsの変数を他のものに変更し
エラー行より下のwsを、変更後の変数に全て変える必要があります。

mygoonickname · Answer

今回も、Sub　～()と、End Subが対になっていないからかと。

Sub SendMail_with_Files()がないですね。　消されたのでしょうかね。
Call SendMail_with_Filesで、行き先がないからかと。

下記の2行を消せば、今回のエラーはなくなりますが。。。
Call SendMail_with_Files　←　消す
End Sub　←　消す
Dim ws As Worksheet　ここから残す

mygoonickname · Answer

No.1の者です。

私のPCに、Outlookの環境がないので、最後までテストができません。
一番最初に提示したリンク先で、準備2. VBEで外部ライブラリへの参照設定でOutlook型を追加のレ点チェックはできているでしょうか？

元々質問者さんが提示してあるプログラムは、Excelファイルをどこかへ
保存するものなのでしょうか？　その保存したパスが必要になります。

あと、SendMail_with_Filesのプログラムが独立しているので、質問者さん
のプログラムの最後に、call SendMail_with_Files　とかが必要です。

下記は、質問者さんしか分からないので、その部分の修正は終わっている？
＞<<<適宜修正の部分を修正して下さい。
＞シート名と、保存したファイルのパスの2か所
    Set ws = ThisWorkbook.Worksheets("Sheet1") '<<<適宜修正

Sheet1を、下記が書かれているシート名へ変更が必要
１．送信先 は４名になります。
１の送信先はセルAE2値
２の送信先はセルAE3値
３の送信先はセルAE4値
４の送信先はセルAE5値

files(0) = ws.Range("B8").Value ' <<<適宜修正 保存したブックのパスを指定

保存したパスが必要。　固定なら、上記を下記の様に変更。
手動でパスを設定するなら、そのパスを変数に入れておいて、変数を指定。
files(0) = "パス～.xlsx"’固定のパスなら
files(0) = 変数

mygoonickname · Answer

No.1の者です。

質問される前にご自分でプログラムを見られた方が良いかと思うのですが。
メッセージを見れば、原因がある程度分かると思うのですが。。。
失礼ですが、エクセル小僧さんは、VBAを知らない方でしょうか？

下記のどちらかが不要です。

Sub メール送信()
Sub Macroの保存2()

Subで始まったら、End Subが対になります。　基本です。。。
Subが続けて出てくる事はありません。

mygoonickname · Answer

No.1の者です。

画像の下側で、範囲選択されているOption Explicitを消して下さい。
後学のためにも、この命令が、何を意味するかを、調べてみて下さい。

mygoonickname · Answer

No.1の者です。

下記で、大半はできているかと思います。
<<<適宜修正の部分を修正して下さい。
シート名と、保存したファイルのパスの2か所
動作確認はしていませんので、質問者さんの方で動作確認して下さい。

提示されているプログラムが組めるなら、下記に必要なセルを入れるだけで
大半が完成できると思うのですが。。。

こちらは一旦閉じて、エラーが発生した場合は、修正したマクロを提示
して、再度質問されたらと思います。

'プログラム0｜変数設定の指定
Option Explicit
 
'プログラム1｜プログラム開始
Sub SendMail_with_Files()
 
    'プログラム2｜シート設定
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1") '<<<適宜修正
         
    'プログラム3｜Outlookアプリケーションを起動
    Dim outlookObj As Outlook.Application
    Set outlookObj = New Outlook.Application
    
    'プログラム4｜Outlookメールを作成
    Dim mymail As Outlook.MailItem
    Set mymail = outlookObj.CreateItem(olMailItem)
    
    'プログラム5｜メール情報を設定
    mymail.BodyFormat = 3        'リッチテキストに変更
    mymail.To = ws.Range("AE2").Value   'To宛先
    mymail.CC = ws.Range("AE3").Value & " ; " & ws.Range("AE4").Value & " ; " & ws.Range("AE5").Value   'cc宛先
'    mymail.BCC = ws.Range("B4").Value  'bcc宛先
    mymail.Subject = ws.Range("P1").Value     '件名
    
    'プログラム6｜メール本文を設定
    Dim mailbody As String, credit As String
    mailbody = "お世話になっております｡" & vbCrLf & "受付担当者様" & vbCrLf & "受付シートをお送りいたします。" & vbCrLf & "ご確認をよろしくお願いいたします。"
'    credit = ws.Range("B7").Value
'    mymail.Body = mailbody & vbCrLf & vbCrLf & credit & vbCrLf
    
    'プログラム7｜メール本文の文字数をカウント
    Dim wordcount As Long
    wordcount = Len(mailbody) + 1
    
    'プログラム8｜メール表示
    mymail.Display
    
    'プログラム9｜メールに添付するファイル名を取得
    Dim files(0) As String
    files(0) = ws.Range("B8").Value ' <<<適宜修正 保存したブックのパスを指定
'    files(1) = ws.Range("B9").Value
'    files(2) = ws.Range("B10").Value
    
    'プログラム10｜メールに複数の添付ファイルを設定
    Dim attachedfile As String
    Dim i As Long
    For i = 0 To 0
        If Not files(i) = "" Then
            attachedfile = ThisWorkbook.Path & "\" & files(i)
            mymail.Attachments.Add attachedfile, olByValue, wordcount + i
        End If
    Next
            
    'プログラム11｜メール保存、送信
    'mymail.Save    '下書き保存
    'mymail.Send    'メール送信
 
    'プログラム12｜オブジェクト解放
    Set mymail = Nothing
    Set outlookObj = Nothing
    
'プログラム13｜プログラム終了
End Sub

mygoonickname · Answer

こんにちは。

直接の回答ではありませんが、
下記に、Excelから、メールに添付して送信するマクロの例がありますので、
先ずは、それを参考に作成されては？と思います。

https://fastclassinfo.com/entry/vba_outlook_attached_several_files/

マクロのコードの追加について教えてください。

シートをコピー2の Dim ws As Worksheet と

今回も、Sub ～()と、End Subが対になっていないからかと。

No.1の者です。

No.1の者です。

No.1の者です。

No.1の者です。

こんにちは。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

シートをコピー2の　Dim ws　As Worksheet　と

今回も、Sub　～()と、End Subが対になっていないからかと。