Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 7全般 : Excel 2010)
Outlookメールボックスを複数立ち上げる
投稿日時: 17/10/23 10:46:05
投稿者: 1234567890

現在、Excel VBAにてOutlookメールを複数立ち上げるツールを作ろうとしています。
 
具体的な状況およびフローとしては、以下の通りです。
1. 複数のシートがある。
2. 複数あるシートのうちの一つのシートのセルに書いてあるメールアドレス一覧を取得し、OutlookメールのTo欄に貼り付ける。メールアドレスがそれぞれ違うので、各メールアドレスごとのメールボックスを立ち上げる。(このため複数のメールボックスを開くことになる)
3. また、メールボックスの件名や本文はもう一つ別のシートを参照して、そこから値をとる。
 
現在、つっかえているのは2の項目です。このパートでは繰り返し文を使うのですが、どうしてもうまくメールアドレスを取得してくれず、途方にくれています。
ちなみにソースコードは以下のようになります。繰り返し文の使い方で何がおかしいのか、そしてどのように文を変えたらメールボックスが複数立ち上がるか教えていただけないでしょうか。よろしくお願いします。
 
'Outlookオブジェクト生成
     Dim OL As Outlook.Application
    Dim MI As Outlook.MailItem
    Dim Sheet_Setting As Object
    Dim Sheet_ControlPanel As Object
    Const DRow_Setting_Start As Long = 7
    Const eRow_Setting_Start As Long = 7
    Dim Sheet_Control As Object
     
    Set OL = CreateObject("Outlook.Application")
    Set MI = OL.CreateItem(olMailItem)
    Set oSheet_Setting = ThisWorkbook.Worksheets("メアド一覧シート")
    Set oSheet_Control = ThisWorkbook.Worksheets("メール本文など")
      
     Dim Data_Look As Variant
     Dim Data_Look2 As Variant
      
     For Data_Look = 1 To Cells("D", 7).End(xlUp).Row
     For Data_Look2 = 1 To Cells("E", 7).End(xlUp).Row
  
     Dim eRow, lRow As Long
           eRow = eRow_Setting_Start
            lRow = DRow_Setting_Start
                     
           Do While Sheet_Setting.Range("E" & eRow).Value = "○" And Sheet_Setting.Range("D" & lRow).Value <> ""
            
           'あて先
           MI.To = Sheet_Setting.Range("D" & lRow).Value
           '件名
           MI.Subject = Sheet_Control.Range("C43")
           '本文
           MI.Body = Sheet_Control.Range("C44")
           'メール表示
           MI.display
            
           eRow = eRow + 1
     lRow = lRow + 1
 
        Exit Do
        Loop
        Next Data_Look
        Next Data_Look2
         
    'オブジェクト解放
     Set OL = Nothing
    Set MI = Nothing
End Sub

回答
投稿日時: 17/10/23 12:13:39
投稿者: 隠居じーさん

引用:

   Exit Do
 Loop

 
内容はよくわかりませんが
Do While 以降
条件が合えば一回だけ処理をしてそのままループを
抜けてしまっているのでは。
原因、無条件でExit Do
 
違ってたら済みません
<(__)> …
 
m< >m

投稿日時: 17/10/23 13:21:04
投稿者: 1234567890

隠居じーさん さん
 
コメントありがとうございます。
さきほど、Exit Doをなしにしてトライしてみましたが、結果は変わらずです・・・。
(Next Data_LookのData_Lookの変数の参照が無効というエラーが出ます。)
 
変数宣言はしているし、型も間違ってないと思うのですが。。。

回答
投稿日時: 17/10/23 13:34:27
投稿者: Suzu

引用:
For Data_Look = 1 To Cells("D", 7).End(xlUp).Row
     For Data_Look2 = 1 To Cells("E", 7).End(xlUp).Row

 
 これ、アクティブシート D列、E列の最終データの行を 拾っていますが 大丈夫でしょうか。

回答
投稿日時: 17/10/23 13:39:41
投稿者: あのん345

1234567890 さんの引用:
For Data_Look = 1 To Cells("D", 7).End(xlUp).Row
For Data_Look2 = 1 To Cells("E", 7).End(xlUp).Row

 
これはここに入力したときの誤記ですか?
ただの誤記なら失礼しました。

投稿日時: 17/10/23 13:53:04
投稿者: 1234567890

Suzuさん
 
コメントありがとうございます。
あれ、これは最終行を拾うというロジックでしたっけ・・・。
「最終行まで」という認識だったのですが。ちょっと調べなおしてみます。

回答
投稿日時: 17/10/23 13:53:45
投稿者: 隠居じーさん

部分、部分ですみません。cellsの値が、逆では?
冒頭のOLも他でユーザー定義などされていますか?
エラーで落ちます。excelは2016なので変わらないと思うのですが
全てコードは表示していただいていますでしょうか?
取り急ぎ気付きの点のみ
勘違い、間違いでしたら、お許しを

投稿日時: 17/10/23 13:57:32
投稿者: 1234567890

あのん345 さん
 
コメントありがとうございます。
いえ、誤記ではないと思います。ここで表現したかったのは、D列7行目以降・E列7行目以降のすべての値を参照して、E列7行目以降に値がある場合はメールボックスのToにD列7行目以降に入っているあて先を入れる(E列7行目で○という文字がある場合、メールアドレスをToに自動的に入れる仕組みとなる) ということです。
これだとその表現になっていないのでしょうか??

投稿日時: 17/10/23 14:05:19
投稿者: 1234567890

隠居じーさん さん
 
Cellsの値の表記順番は調べたところ、間違っていないようです。
ただ、End(xlUp)は最終行を取得するためのロジックみたいですので、こちらを見直したほうがよさそうです。(Suzuさんもご指摘されてましたが)
 
OLのユーザ定義は行っているはずです。
「ExcelからOutlookを参照するようにする」という参照設定をさされてますよね?

回答
投稿日時: 17/10/23 14:37:26
投稿者: Suzu

あのんサン の

引用:
1234567890 さんの引用:
For Data_Look = 1 To Cells("D", 7).End(xlUp).Row
For Data_Look2 = 1 To Cells("E", 7).End(xlUp).Row
 
  
これはここに入力したときの誤記ですか?

 
 も、
隠居じーさん の
 
引用:
部分、部分ですみません。cellsの値が、逆では?

 
も、同じ Cells の引数 の事を言いたいのです。
 
引用:
Cellsの値の表記順番は調べたところ、間違っていないようです。

 
いえ。間違っていますよ。
 
Sub cellSelectTest()
    Cells("D", 7).Activate
End Sub
 
 
手元 Excel 2010 では 「型が一致しません」エラーになります。
 
 
私が言いたかったのは
引用:
これ、アクティブシート D列、E列の最終データの行を 拾っていますが 大丈夫でしょうか。

 
・セルの指定方法
・アクティブシート
  それぞれが 原因でない確証が取れ、原因が判らない様であれば
 
引用:
てもうまくメールアドレスを取得してくれず、途方にくれています。

この内容、
  どのような希望に対し
  現状どうなっている
のかの説明をお願いいたします。

投稿日時: 17/10/23 15:00:31
投稿者: 1234567890

Suzuさん
 
Cellsの引数について、失礼しました。
こちらは再び検索しましたが、順番が違いました。正しくは、Cells(7, "D")ですね。
 
Cellsの引数を修正してもエラーは取れなかったので、原因はまた何か別のところにありそうです。
また、アクティブシートを指定してもだめでした。
 
>てもうまくメールアドレスを取得してくれず、途方にくれています。
ここでは、条件「E列7行目以降で○印がある」という条件を満たせば、シート「メアド一覧シート」にあるメールアドレス(以下の数字1~36)を取得し、それをOutlookのアドレス欄(To)に貼り付けたいのです。ですが、該当シートをアクティブにしても、これら値をメールボックスのTo欄に貼り付けてくれず、どうしたものかと詰まっているところです。
 
送信先メールアドレス
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

回答
投稿日時: 17/10/23 17:20:55
投稿者: Nao

こんにちは。横から失礼します。
 

引用:
(Next Data_LookのData_Lookの変数の参照が無効というエラーが出ます。)
変数宣言はしているし、型も間違ってないと思うのですが。。。

引用:
For Data_Look = 1 To Cells(7, "D").End(xlUp).Row
    For Data_Look2 = 1 To Cells(7, "E").End(xlUp).Row
        ・
        ・
    Next Data_Look
Next Data_Look2

コードはよく見ていませんが、とりあえず
Next Data_Look と Next Data_Look2 順番が逆じゃないですか?
 
 

回答
投稿日時: 17/10/23 17:35:02
投稿者: 隠居じーさん

引用:

「ExcelからOutlookを参照するようにする」という参照設定をさされてますよね?

m(_ _ )m
忘れてました!
シート名変えました
ご参考まで
Sub test()
  Dim OL As Outlook.Application
  Dim MI As Outlook.MailItem
  Dim Sheet_Setting As Object
  Dim Sheet_ControlPanel As Object
  Dim Sheet_Control As Object
  Set OL = CreateObject("Outlook.Application")
  Set MI = OL.CreateItem(olMailItem)
  Set Sheet_Setting = ThisWorkbook.Worksheets("メルアド一覧")
  Set Sheet_Control = ThisWorkbook.Worksheets("本文")
  Dim Data_Look As Long
  Dim tmp As String
  For Data_Look = 7 To Cells(Rows.Count, "D").End(xlUp).Row
  If Sheet_Setting.Range("D" & Data_Look).Offset(0, 1) = "〇" Then
    If Data_Look = Cells(Rows.Count, "E").End(xlUp).Row Then
      tmp = tmp & Sheet_Setting.Range("D" & Data_Look).Value
      Exit For
    Else
    tmp = tmp & Sheet_Setting.Range("D" & Data_Look).Value & ":"
    MsgBox tmp
    End If
  End If
  Next Data_Look
  MI.To = tmp
  '件名
  MI.Subject = Sheet_Control.Range("C43")
  '本文
  MI.Body = Sheet_Control.Range("C44")
  'メール表示
  MI.Display
  'オブジェクト解放
  Set OL = Nothing
  Set MI = Nothing
End Sub

回答
投稿日時: 17/10/23 17:50:02
投稿者: 隠居じーさん

1234567890様
追記
メルアド一覧という名のシートの内容が下記とし
   D  E
  
7   1    
8   2     〇
9   3    
10  4     〇
11  5    
12  6     〇
13  7    
14  8     〇
15  9    
16  10     〇
17  11    
18  12    
シート名、本文 のc43、c44に情報がある、前程です。
 
 

回答
投稿日時: 17/10/23 19:28:01
投稿者: 隠居じーさん

度々、すみません、
追記の追記です
シート、メルアド一覧がアクティブになっている、
前程です。
(^^;
 
<(_ _)>
 

回答
投稿日時: 17/10/24 09:09:38
投稿者: 隠居じーさん

直接、このスレとは関係ないと思いますが。
outlook2016の場合
メルアドとメルアドの区切りは:コロンではなく
セミコロン;でした
お詫びして、訂正いたします。
、だというサイトもありましたが?
TO、CC、BCC等も使い分けがあるようですね。
お使いのメールソフトに合わせてください。
 
<(_ _)>
 

投稿日時: 17/10/24 09:15:41
投稿者: 1234567890

Nao さん
 
コメントありがとうございます。
Next Data_Look2
        Next Data_Look
にしたら、何とかメールボックスが立ち上がりました。そして、おそらく次のループへいく段階でまたエラーが出ました。(PCとしては、とりあえず次のループの処理に向かおうとしている、と思います。。。)
 
Nextの隣に置く変数の順序が違うだけで、こうも動かなくなるのですね・・・。気づかなかったポイントなので、次回以降同じようなエラーが再現された場合はこちらも疑ってみます。

投稿日時: 17/10/24 09:53:50
投稿者: 1234567890

隠居じーさん さん
 
コードのシェアありがとうございます。
 
さきほどためしに自分のPCでコードをコピペして動かしてみたのですが、繰り返し処理が行われていないようです。もし繰り返し処理が行われていたら、条件(E列に○印がある、D列にメールアドレスがある)がそろっている時点で複数のメールボックスが立ち上がるはずなのですが、そのような表示にはならないので一体何が間違っているのか謎です・・・。

回答
投稿日時: 17/10/24 11:00:16
投稿者: 隠居じーさん

1234567890さま
 
まづ、メーラーは複数起動はされません。
最後に一回だけです。
TO欄に2:4:6:8:10の様にセットされます(一括送信用)
:は;に変更が必要!
何も表示されてないのでしたら空のセルを見に行っていますので
シート名が間違っていないか、
(お使いのメルアドと〇があるシート名に変更してください)
データの格納場所D列7行以降に
メルアド、E列7行以降に〇が複数あるか
ご確認していただき、メルアド格納シートを
アクティブにしたうえで再度動作をご確認下さい。
尚、メール本文が各メルアド毎に違うのでしたら
別途マクロが必要です。当初のお申し出とは異なりますが
ご参考までにアップさせていただきました。

投稿日時: 17/10/24 14:21:18
投稿者: 1234567890

隠居じーさん  さん
   
メールボックスは複数起動されないんですね。私の想像がずれていたのか・・・。
   
シート名を確認し、7行目以降に○やメールアドレスが入っていることも確認できた上でもう一度コード動作を試して見ましたが、一向にメールアドレスに2, 4, 6, 8というふうに表示されないです。To部分は空になっていました。
   
他に考えられる原因は何でしょう・・・?

回答
投稿日時: 17/10/24 15:45:03
投稿者: 隠居じーさん

1234567890さん
@
Set Sheet_Setting = ThisWorkbook.Worksheets("メルアド一覧")
Set Sheet_Control = ThisWorkbook.Worksheets("本文")
上記のシート名を今現在お使いのPCのエクセルのシート名に変更
して戴きましたか。
A
Sheet_Setting.Activate
For Data_Look = 7 To Cells(Rows.Count, "D").End(xlUp).Row
上記のFor〜文のうえでシートをアクティブにしてください。
 
B
双方、7行目から〜
D列 = メルアド...(いまは数値)
E列 = 〇
C
コピペしていただいた、場所ですが
Sheet_Settingシート
thisworkbook
標準モジュール
のいずれかか確認してください。上記以外だと
TO欄は空白になります。
 
あとは、情報さえ入力されていれば動くはずです。
お試し下さい
 
 

回答
投稿日時: 17/10/24 17:36:59
投稿者: Nao

こんにちは。
 
メールボックスを複数って…
メール作成画面を複数ってことだったんですね(^^ゞ
 

Sub MailTest()
'Outlookオブジェクト生成
Dim OL As Outlook.Application
Dim MI As Outlook.MailItem
Dim Sheet_Setting As Worksheet
Dim Sheet_Control As Worksheet
Dim lRow As Long
      
    Set OL = CreateObject("Outlook.Application")
    Set Sheet_Setting = Sheets("メアド一覧シート")
    Set Sheet_Control = Sheets("メール本文など")
       
    For lRow = 7 To Sheet_Setting.Cells(Rows.Count, "D").End(xlUp).Row
        If Sheet_Setting.Range("E" & lRow).Value = "○" And _
                Sheet_Setting.Range("D" & lRow).Value <> "" Then
            Set MI = OL.CreateItem(olMailItem)
           'あて先
            MI.To = Sheet_Setting.Range("D" & lRow).Value
            '件名
            MI.Subject = Sheet_Control.Range("C43")
            '本文
            MI.Body = Sheet_Control.Range("C44")
            'メール表示
            MI.display
            Set MI = Nothing
        End If
    Next lRow
          
    'オブジェクト解放
    Set OL = Nothing
End Sub

 
隠居じーさん さんのコードがうまく動かないのは
1234567890 さんの"○"と隠居じーさん さんの"〇"が別物だからじゃないですかね。
 

回答
投稿日時: 17/10/24 19:15:29
投稿者: 隠居じーさん

引用:

隠居じーさん さんのコードがうまく動かないのは
1234567890 さんの"○"と隠居じーさん さんの"〇"が別物だからじゃないですかね。

Nao 様 ^^
 
その通りかもしれませんね。可能性は大だと思います。
 
ご呈示のコードもフラグを”〇”から英字のqに変更して実行致しました。
qを入力した数だけメーラが、TO欄にメルアドが表示され、起動
されました。
有難うございました。
 
 
<(_ _)>
 

投稿日時: 17/10/25 15:45:59
投稿者: 1234567890

隠居じーさん、Nao さん
 
○の字体が違っていて動かない可能性は大ですね・・・。
環境に左右されない文字を使ってみて、また試してみます。

回答
投稿日時: 17/10/25 16:23:17
投稿者: Nao

こんにちは。
 
> ○の字体が違っていて
 
勘違いされていませんか?
隠居じーさん さんの"〇"は漢数字のゼロです。
1234567890 さんの"○"は丸印です。
なので、別物です。
 
> 環境に左右されない文字
 
というよりは、間違えやすい文字ということです。
アルファベットの O (オー)と数字の 0 (ゼロ)みたいに。
 

投稿日時: 17/10/31 10:18:09
投稿者: 1234567890

Naoさん
 
なるほど、私のPC上からだと記号の○と漢数字の0の見分けがつかなかったです。
このあたりは紛らわしいですよね。
 

投稿日時: 17/10/31 10:24:03
投稿者: 1234567890

皆さん
本題について、ご意見をいただきありがとうございました。
自分でも先週末にロジックを見直してみて、色々トライしてみました。
 
・・・どうも、このスレッドで一番最初にシェアした私のコードだと、無限ループに入ることが判明しました。データがすべてセル内に入っている行を参照した繰り返し文を書かないと、PCではいつ繰り返し処理を終わらせればいいか、という判断がつかないようです。
てっきり、「データがセルにぼちぼち入ってるかどうか確認して、それをもとにメールを作れ」という繰り返し文を作ったらPCは理解してくれるものと思い込んでいました。
 
まだプログラミングをはじめてから浅く知識が足りないため、繰り返し文の使い方は本当に難しく感じます・・・。

回答
投稿日時: 17/11/01 16:22:28
投稿者: もこな2

横から失礼します。
とりあえず、メールの送信を判定する処理とメール作成画面を作る処理を分けてみてはいかがでしょうか
  
  
初めての投稿でみづらいかもしれませんがサンプルコードです
(実行環境がないのでテストしてませんが、、、)
  

Sub 送信判定() 
Dim oSheet_Setting As Worksheet 
Dim eRow As Long 
 
Set oSheet_Setting = ThisWorkbook.Worksheets("メアド一覧シート") 
With oSheet_Setting 
    For eRow = 7 To .Cells(.Rows.Count, "E").End(xlUp).Row 
        If .Cells(eRow, "E").Value = "○" And .Cells(eRow, "D").Value <> "" Then 
            Call CreateMail(.Cells(eRow, "D").Value) 
        End If 
    Next eRow 
End With 
End Sub 
 
Sub CreateMail(Send_Address As String) 
 'シート設定 
 Dim oSheet_Control As Worksheet 
 Set oSheet_Control = ThisWorkbook.Worksheets("メール本文など") 
 
'Outlookオブジェクト設定 
Dim oApp As New Outlook.Application 
Dim MI As Outlook.MailItem 
Set MI = oApp.CreateItem(olMailItem) 
 
'あて先 
    MI.To = Send_Address 
'件名 
    MI.Subject = Sheet_Control.Range("C43") 
'本文 
    MI.Body = Sheet_Control.Range("C44") 
 
'メール表示 
    MI.Display 
 
'オブジェクト解放 
    Set MI = Nothing 
 
End Sub

投稿日時: 17/11/16 17:55:53
投稿者: 1234567890

もこな2さん
返信だいぶ遅れてすみません。
 
コードありがとうございます。
 
うーん、2番目のモジュールのタイトルはSub CreateMail(Send_Address As String)となっているのに、1番目のモジュールのCallの部分で、CreateMailにString型でない引数を入れると型違いと怒られませんか?
この部分、疑問に思いました。

回答
投稿日時: 17/11/17 06:57:00
投稿者: もこな2

1234567890 さんの引用:
2番目のモジュールのタイトルはSub CreateMail(Send_Address As String)となっているのに、1番目のモジュールのCallの部分で、CreateMailにString型でない引数を入れると型違いと怒られませんか?
この部分、疑問に思いました。

1234567890さんの投稿当初のコードですと
Set oSheet_Setting = ThisWorkbook.Worksheets("メアド一覧シート") 
(中略)
 'あて先 
MI.To = Sheet_Setting.Range("D" & lRow).Value
となっていて、自分のを抜粋すると、
Set oSheet_Setting = ThisWorkbook.Worksheets("メアド一覧シート") 
With oSheet_Setting
 Call CreateMail(.Cells(eRow, "D").Value) 
End Sub

Sub CreateMail(Send_Address As String) 
'あて先 
    MI.To = Send_Address
(後略)
End Sub
となっています。
Withステートメントでまとめているのでちょっと分かりづらいかもしれませんが、同じものを参照しています。
(RangeとCellsで使ってるプロパティは違いますが)オブジェクトやwithを展開するとこんな感じです。
ThisWorkbook.Worksheets("メアド一覧シート").Range("D" & lRow).Value
ThisWorkbook.Worksheets("メアド一覧シート").Cells(eRow, "D").Value
どちらも、おなじセルの値(文字列)を使用してる。
セルにメールアドレスが直接入力されているのであれば、その値(文字列)を取得しますし、VlookUP等の関数が仕込んであれば、その計算結果(文字列)、ブランクであれば0文字の(文字列)が返ると思われます。
※関数が仕込んであって計算結果がエラーになっている場合、エラーが文字となってかえる(ハズ)です。("#N/A")という文字列など。
ですので、String型で大丈夫です。

回答
投稿日時: 17/11/17 07:07:30
投稿者: もこな2

RangeプロパティとCellsプロパティの説明については割愛しますが、個人的には、For〜Nextのように行や列が変動するような処理をする場合、Cellsプロパティのほうが使いやすいかなとおもっているので今回はCellsプロパティを使用して記述しました。

投稿日時: 17/11/17 15:57:38
投稿者: 1234567890

もこな2さん
 
なるほどです、確かに.Valueとは書いてあってもその中身そのものはStringですよね。
混乱してました。
 
とすると、Call CreateMail(.Cells(eRow, "D").Value) と書いてもOKですね。
お騒がせしました。

回答
投稿日時: 17/11/17 23:56:09
投稿者: もこな2

1234567890 さんの引用:
確かに.Valueとは書いてあってもその中身そのものはStringですよね。
ですです。
ちなみに、
1234567890 さんの引用:
このスレッドで一番最初にシェアした私のコードだと、無限ループに入ることが判明しました。データがすべてセル内に入っている行を参照した繰り返し文を書かないと、PCではいつ繰り返し処理を終わらせればいいか、という判断がつかないようです。
てっきり、「データがセルにぼちぼち入ってるかどうか確認して、それをもとにメールを作れ」という繰り返し文を作ったらPCは理解してくれるものと思い込んでいました。
ですが、私ならD列ではなく、送信フラグがあるE列の最終行を掴んでからループを回します。
なぜなら、アドレスが入っていないのに送信フラグを立てることはまぁ無いでしょうし、仮にあったとしても「.Cells(eRow, "D").Value <> ""」を満たさないので、メール作成画面の処理に飛ぶことはないです。むしろ、D列にメールアドレスが何行入力されていようが、E列になにか入力されている行まで処理すれば事は足りるので、こちらを推奨。
 
さらに、D列とE列は同じ行を見る処理のようですから、行のカウンタは2つ必要ないですし、開始行をわざわざ定数で用意せず直接記述してやって、オブジェクト型変数を使わず、withステートメントで記述することもできるので、これらを整理すれば以下のように短く記述することもできるように思います。
好みの問題とは思いますが、可読性があがれば問題点が見つけやすくなるとおもいますので、ご参考まで。
'----------------------------------------------------------------------------
Sub 送信判定() 
Dim eRow As Long 
 
With ThisWorkbook.Worksheets("メアド一覧シート") 
    For eRow = 7 To .Cells(.Rows.Count, "E").End(xlUp).Row 
        If .Cells(eRow, "E").Value = "○" And .Cells(eRow, "D").Value <> "" Then _
            Call CreateMail(.Cells(eRow, "D").Value) 
    Next eRow 
End With 
End Sub 
 '----------------------------------------------------------------------------
Sub CreateMail(Send_Address As String) 
'Outlookオブジェクト設定 
Dim oApp As New Outlook.Application 
Dim MI As Outlook.MailItem 
Set MI = oApp.CreateItem(olMailItem) 

With  ThisWorkbook.Worksheets("メール本文など") 
    MI.To = Send_Address 'あて先(メールアドレス)
    MI.Subject = .Range("C43") '件名 
    MI.Body = .Range("C44") '本文
 
    MI.Display 'メール表示 
 
    Set MI = Nothing 'オブジェクト解放 
End With
End Sub
 '----------------------------------------------------------------------------

回答
投稿日時: 17/11/18 19:03:14
投稿者: baoo

繰り返し分に慣れておられないようなので1点だけ。
私が繰り返し文を書く場合は
最初に

For i=0 To 100
Next i
次に
For i=0 To 100
    For j=0 To 100
    Next j
Next i
と書いてから
For i=0 To 100
    For j=0 To 100
        Debug.Print i & "," & j
    Next j
Next i
というように中身を書きます。
 
これはIf文なんかでもそうです。
If i>0 Then
EndIf
を書いてから中身を書きます。
If i>0 Then
    Debug.Print "0より大きい"
Endif

そうすると入れ子で混乱することは少なくなると思います。

回答
投稿日時: 17/11/21 12:50:11
投稿者: 細雪

横入りで失礼します。
 

1234567890 さんの引用:

・・・どうも、このスレッドで一番最初にシェアした私のコードだと、無限ループに入ることが判明しました。

 
無限ループではなく、
 Do〜While で全行総なめ を D列の行数分繰り返し
 上記を E列の行数分繰り返し
という、無駄ループをしているわけですね。
全部で100行分のデータがある場合、最大で100^3 = 100万回同じ処理をするので
そりゃ、時間がかかって無限ループに見えるかもしれません。
ま、どちらにしても同じメールを同じ人に100通送ろうとしているわけですから
うまくない処理・・・というよりかなり迷惑と言えそうです。
 
 
 
メールを作成する条件を整理してみると解ると思いますが、
「E列に「○(マル)」が入っている」が大前提と言えます。
そんなわけで、ここだけ判断してループしてやれば良いような気がします。
D列の条件「メールアドレスの登録がある=空白ではない」は IF を使って突っ込んでやります。
よって、
 
'Outlookオブジェクト生成
    Dim OL As Outlook.Application
    Dim MI As Outlook.MailItem
    Dim myBody As WorkSheet
      
    Set OL = CreateObject("Outlook.Application")
    Set myBody = Worksheets("メール本文など")
 
    With Worksheets("メアド一覧シート")
        For i = 7 To .Cells(Rows.Count, "E").End(xlUp).Row
      ' E列も「空白じゃなかったら」に変更
      ' ○だの〇だの面倒なので
            If .Range("E" & i).Value <> "" And .Range("D" & i).Value <> "" Then
                Set MI = OL.CreateItem(olMailItem)
                    MI.To = .Range("D" & i).Value 'あて先
                    MI.Subject = myBody.Range("C43").Value '件名
                    MI.Body = myBody.Range("C44").Value '本文
                    MI.display 'メール表示
 
                Set MI = Nothing
            End If
        Next i
    End With
 
    Set OL = Nothing
 
こんな感じで、皆さんのものに近いものが書きあがりました。
テストはしていないのと、ここに手打ちなので文法が間違ってるかもしれませんがご愛嬌で。
 
慣れるまではDoにしてもForにしても、いわゆる繰り返しは1回。
条件が重なるならIFで対処、にしておく方が良いのかもしれませんね。

トピックに返信