[[20250423153158]]　『Excelでメール』（メール魂）　ページの最後に飛ぶ

『Excelでメール』（メール魂）

下記のマクロを使用してExcelでメールを送っています
少し変更したく弄ったのですが分からないので教えて下さい

Excel表
A列：仕入先CD
B列：仕入先名
C列：送信FLG
D列：ｔｏ
E列：ｃｃ
F列：ｂｃｃ
G列：メールタイトル
H列：メール本文1
I列：メール本文2
J列：別途関数
K列：メール本文3
L列：別途関数
M列：メール本文4
N列：添付アドレス
O列：別途文字1
P列：別途文字2
Q列：別途文字3

下記がマクロ
Sub MAIL_MAKE()

    Dim rc As Integer
    rc = MsgBox("処理を行いますか？", vbYesNo + vbQuestion, "確認")
    If rc = vbYes Then
    Else
        End
    End If

Dim rowcnt As Integer

rowcnt = 2

Dim objOutlook As Outlook.Application
Dim objMail As Outlook.MailItem
Dim wsMail As Worksheet

Set objOutlook = New Outlook.Application

Dim syomei As String

Dim temp_cc As String

Dim main_sheet As Worksheet

Set main_sheet = ThisWorkbook.Worksheets("ご案内")

With main_sheet

    Do While .Cells(rowcnt, 6) <> ""

        If Trim(.Cells(rowcnt, 3)) <> "" Then

            Set objMail = objOutlook.CreateItem(olMailItem)

            With wsMail

                objMail.To = main_sheet.Cells(rowcnt, 4)   'TO
                objMail.CC = main_sheet.Cells(rowcnt, 5)    'CC
                objMail.BCC = main_sheet.Cells(rowcnt, 6)   'BCC

                objMail.Subject = main_sheet.Cells(rowcnt, 7) 'メールの件名を設定"

                objMail.Body = main_sheet.Cells(rowcnt, 11) & vbCrLf & main_sheet.Cells(rowcnt, 13)

                Dim アドレス As String
                アドレス = main_sheet.Cells(rowcnt, 14)
                objMail.Attachments.Add アドレス

                objMail.Display

                '名前の解決
                For Each tmpRecip In objMail.Recipients
                    tmpRecip.Resolve
                    If Not tmpRecip.Resolve Then
                    '解決不可
                    End If
                Next

                objMail.Save

            End With

            Set objMail = Nothing

        End If

        rowcnt = rowcnt + 1

    Loop

    Set objOutlook = Nothing

End With

End Sub

上記を実行すると
下記でエラーになります
objMail.Attachments.Add アドレス

そこで下記の数字を6にすると何もアクションが起きないで
その他の数字にするとエラーになります
Do While .Cells(rowcnt, 6) <> ""

どのようにすればよいでしょうか？
また、Do While .Cells(rowcnt, 6) <> ""の部分は何を表しているのでしょうか

よろしくお願いします。

＜使用 Excel：Microsoft365、使用 OS：Windows11 ＞

すみません、削除の方法が分からないので
自己解決しました。
（メール魂） 2025/04/23(水) 15:44:26

解決したということなんでもう見てないかもしれませんが、気になったところなど。

 ・「wsMail」を使っておらず意味がない
 ・冒頭でMsgBoxを使って処理するかどうか判定しているが、記述がやや冗長に思われる
 ・"下記の数字を6にすると～"という発言から、列番号を示しているということが理解できていないとおもわれる

というようなことを踏まえて、私なりに整理すると↓のようになります。

    Sub 整理()
        Dim rowcnt As Integer
        Dim objOutlook As Outlook.Application
        Dim objMail As Outlook.MailItem
        Set objOutlook = New Outlook.Application

        If MsgBox("処理を行いますか？", vbYesNo + vbQuestion, "確認") = vbYes Then
            With ThisWorkbook.Worksheets("ご案内")
                rowcnt = 2
                Do While .Cells(rowcnt, "F") <> "" '2行目からはじめてF列が空白になる手前まで処理する
                    If Trim(.Cells(rowcnt, "C")) <> "" Then 'C列が空白じゃないときだけ処理する

                        Set objMail = objOutlook.CreateItem(olMailItem)
                        With ThisWorkbook.Worksheets("ご案内")
                            objMail.To = .Cells(rowcnt, "D").Value
                            objMail.CC = .Cells(rowcnt, "E").Value
                            objMail.BCC = .Cells(rowcnt, "F").Value
                            objMail.Subject = .Cells(rowcnt, "G").Value

                            '▼本文（提示のコードではK列とM列のみ対象にしている）
                            objMail.Body = _
                                .Cells(rowcnt, "K").Value & vbCrLf & _
                                .Cells(rowcnt, "M").Value

                            '▼添付ファイルの添付（空欄の時は処理しない）
                            If .Cells(rowcnt, "M").Value <> "" Then
                                objMail.Attachments.Add .Cells(rowcnt, "M").Value
                            End If

                            objMail.Display

                            '名前解決は省略
                        End With
                    End If

                    rowcnt = rowcnt + 1
                Loop
            End With
        End If
    End Sub

したがって、件の箇所でエラーになるのは「アドレス」に有効なファイルパスが格納されてないからでしょう。
ループ条件をいじってどうにかする問題ではないです。

（もこな２） 2025/04/24(木) 23:58:32

コメント返信：

[ 一覧(最新更新順) ]

[[20250423153158]] 『Excelでメール』（メール魂） ページの最後に飛ぶ

[[20250423153158]]　『Excelでメール』（メール魂）　ページの最後に飛ぶ