アプリ版:「スタンプのみでお礼する」機能のリリースについて

VBA初心者です。

Outlookの特定のメールフォルダ(受信フォルダの下層のフォルダ『○○○自動配信メール』)のメールの
・件名
・未読(TrueかFalseか)
・本文
をエクセルで表示させるマクロを作りました。
(前回のデータを消して6行目から入力する)

このマクロは未読メールに対してのみ行いたいため、
If文を使って未読メールなら以下の処理を実行し、
もし未読メールでないならば、Else以下の処理を実行する
というようにしたいのですが、エラーが出てきてうまくいきません。

マクロの内容は下記のとおりです。
会社での業務に関するマクロのため、固有名詞があるところは○○○にしています。
------------------------------------------------------------------------
Option Explicit

Sub ○○○自動配信メールを取得()
Dim tol As Outlook.Application
Dim tns As Object
Dim toldir As Object
Dim tSyncObj As Outlook.SyncObject
Dim tmail As Object
Dim i As Integer
Dim lrow As Long



'データの表示エリアをクリアする
Rows("6:9999").Delete Shift:=xlUp '6行目から削除する
Range("a1").Select

'Outlookのインスタンスを作成
Set tol = New Outlook.Application
'名前空間を取得
Set tns = tol.GetNamespace("MAPI")
'○○○自動配信メールのフォルダを取得
Set toldir = tns.GetDefaultFolder(olFolderInbox).Folders("○○○自動配信メール")

' 未読のメールのみに処理を行なう
If tmail.UnRead = True Then

'項目名の表示
lrow = 6
Cells(lrow, 2) = "件名"
Cells(lrow, 3) = "未読"
Cells(lrow, 4) = "本文"

'アイテム数をループする
For i = 1 To toldir.Items.Count
'アイテムオブジェクト
Set tmail = toldir.Items.Item(i)

lrow = lrow + 1
'件名
Cells(lrow, 2) = tmail.Subject
'未読
Cells(lrow, 3) = tmail.UnRead
'本文
Cells(lrow, 4) = tmail.Body

Else

MsgBox "作成すべき教育記録はありません。"


End If

Set toldir = Nothing
Set tns = Nothing
Set tol = Nothing


End Sub
-------------------------------------------------------------------------
上記でマクロを実行すると、
『コンパイルエラー:Elseに対するIfがありません。』と表示されます。

どこの箇所から問題が起きているか絞ろうとして、
IfからElseまでの行を削除したり元に戻したりしてマクロを実行させてみた結果、
添付した画像の箇所を削除するときにエラーのメッセージが

『実行時エラー 91
 オブジェクト変数またはWithブロック変数が設定されていません。』

に変わったので、この箇所が問題なのかなと思いましたが、
どのように直したらIfをElseに対するIfと認識してくれるのかがわかりません。

どなたか詳しい方、ご教授いただけますと助かります。
どうかよろしくお願いいたします。

「Excel VBAでIf 条件式 the」の質問画像

質問者からの補足コメント

  • うーん・・・

    fujillinさん、 WindFallerさん

    ご回答いただきありがとうございます。
    会社でしか動かせないため、確認が遅くなって申し訳ございません。

    fujillinさんの仰る通りに
    Set tmail = toldir.Items.Item(i)の後にIf tmail.UnRead = True Then
    End If の後にNext iを入れたらうまく動きました。

    しかし、『作成すべき~』が○○○自動配信メールのフォルダに
    入っている回数分出てくるため、消すのが大変でした。


    そこで、
    If ○○○自動配信メールフォルダ内の未読メールが0 Then
    Msgbox "作成すべき~"
    Exit(このマクロを終了)

    Else   ←(未読メールが1通以上ある)
    Irow = Irow + 1~
    と続けられればできるのかなと思ったのですが、可能でしょうか?

      補足日時:2017/04/07 22:00
  • うーん・・・

    すみません、もう一件追加です。

    未読メールはExcelでの抽出が終わった後は既読にしたいのですが、
    間違った箇所に
    For Each tmail In toldir.Items
    tmail.UnRead = False

    と入れてしまっているようで、
    1通分ほどしかExcelに表示されなかったです。
    (繰り返し操作の中に入れたため、最初の1通分しか適用されなかった
    との認識でいます)

    この場合、どの箇所に入れればすべての未読メールに適用される
    のでしょうか?

    質問ばかりで申し訳ございません。

      補足日時:2017/04/07 22:04
  • fujillinさん、 WindFallerさん

    ご回答ありがとうございます。返答が遅くなり大変失礼いたしました。

    今回はfujillinさんのご回答を元に、
    ・ループ終了後のlrowの値をカウントし、6(=1行も増えていない)時メッセージを表示させる旨を追記(①)
    ・tmail.UnRead = Falseを未読メールの処理を行っている最後に追記(②)

    この土日に少し手を加え、
    以前1枚だったシートを「無題」と「○○○メール貼り付け用シート」の2枚にしました。
    マクロのボタンは「無題」にあり、ボタンを押すと「○○○メール~シート」がアクティブになり、○○○自動配信メールの情報は後者に反映されます。
    メール受信日も必要なので追加しました。

    しかし①の部分がよくないらしく(ステップインで各工程を確認)、『オブジェクト変数またはWithブロック変数が設定されていません』と表示されます。

      補足日時:2017/04/10 21:06
  • 現在のマクロは下記です。
    -----------------------------------------------
    Option Explicit

    Sub ○○○自動配信メールを取得()
    Dim tol As Outlook.Application
     ~(文字数制限のため、前回と変わらないところは~で省略
    Dim lrow As Long
    Dim rowData As Long '2017.04.09追加
    Dim wsData As Object '2017.04.10追加

    Sheets("○○○メール貼り付け用シート").Select
    Rows("6:9999").Delete Shift:=xlUp '6行目から削除する
    Range("a1").Select

      補足日時:2017/04/10 21:15
  • 'Outlookのインスタンスを作成

      Set toldir = tns.GetDefaultFolder(olFolderInbox).Folders("○○○自動配信メール")

    '項目名の表示

    Cells(lrow, 4) = "本文"
    Cells(lrow, 5) = "受信日"

    'アイテム数をループする

    Set tmail = toldir.Items.Item(i)

    ' 未読のメールのみに処理を行なう

    '本文
    Cells(lrow, 4) = tmail.Body
    '受信日
    Cells(lrow, 5) = tmail.ReceivedTime

      補足日時:2017/04/10 21:18
  • tmail.UnRead = False '2017.04.09追加 ・・・②
    End If
    Next i

    rowData = wsData.Cells(Rows.Count, 2).End(xlUp).Row
                             '2017.04.09追加_最後の行数を取得 ・・・①
    If rowData = 6 Then
    MsgBox "作成すべき教育記録はありません。"
    End If
    Set toldir = Nothing
    Set tns = Nothing
    Set tol = Nothing
    Sheets("無題").Select
    End Sub

    文字数制限のため分かれてしまい申し訳ございません。

      補足日時:2017/04/10 21:20

A 回答 (6件)

ANo3です



補足でご提示のコードは妙な省略のされ方になっているため、追いかけても文脈を理解できずよくわからないです。
とりあえず、②の後の Next i までは動作しているものと仮定して・・・

>rowData = wsData.Cells(Rows.Count, 2).End(xlUp).Row
で使用している、wsDataって、最初に宣言されているだけなので、何を参照しているのか不明です。(省略された中にあるのかも知れませんが…)
それで、エラーとなっているのではないでしょうか?
また、
>・ループ終了後のlrowの値をカウントし~~①
とありますが、Irowを参照しているようには思えません。
(どの部分がIrowへの参照なのでしょうか?)

なんだか、もっと単純化して考えた方が良いように思います。


一方で、#5の解説にもありますが、未読件数はOutLookのUnReadItemCountプロパティで取得できるようですので、そちらを利用する方法もありますね。
(ダイレクトに必要な値が返るので、算出が不要になります。)
    • good
    • 0

#4の回答者です。



どうやら、私のほうの書き込みは、まったく読まれた形跡がないようですので、これ以上はフィードバックはしませんが。

>If ○○○自動配信メールフォルダ内の未読メールが0 Then
>・ループ終了後のlrowの値をカウントし、6(=1行も増えていない)時メッセージを表示させる旨を追記(①)

の質問に対する答え
私の回答が間違っているのなら、仕方がありませんが、

①.
未読チェックの方法(ループする前に終わっています)
If toldir.UnReadItemCount > 0 Then 'フォルダの未読のチェック'**
「フォルダ内で読まれていないアイテムの数を示す」というプロパティ


はすでに、#4の中で答えていますので割愛します。

以下の方式ですと、シートの負担が多すぎるので、
>Rows("6:9999").Delete Shift:=xlUp '6行目から削除する
(昔と今では、こういう部分の仕様が変わったと聞きます)だから、こう考えました。
  ↓
Intersect(ActiveSheet.UsedRange, Rows("6:9999")).ClearContents '*

データがある場所と、6行~9999行で重なり合うところのデータを消去するというほうが楽だと考えました。以上です。
    • good
    • 0

#2の回答者です。



補足の2件は、これでよいはずです。
'*付きが修正点
'//
 'データの表示エリアをクリアする
 '6行目から削除する
 Intersect(ActiveSheet.UsedRange, Rows("6:9999")).ClearContents '*
 Range("A1").Select
 'Outlookのインスタンスを作成
 Set tol = New Outlook.Application
 '名前空間を取得
 Set tns = tol.GetNamespace("MAPI")
 '○○○自動配信メールのフォルダを取得
 Set toldir = tns.GetDefaultFolder(olFolderInbox).Folders("goo") '("○○○自動配信メール") 
 If toldir.UnReadItemCount > 0 Then 'フォルダの未読のチェック'**
  ' 未読のメールのみに処理を行なう
  lrow = 6
  Cells(lrow, 2) = "件名"
  Cells(lrow, 3) = "未読"
  Cells(lrow, 4) = "本文"
  'アイテム数をループする
  For i = 1 To toldir.Items.Count
   'アイテムオブジェクト
   Set tmail = toldir.Items.Item(i) 
   If tmail.UnRead Then
    lrow = lrow + 1
    Cells(lrow, 2) = tmail.Subject  '件名    
    Cells(lrow, 3) = tmail.UnRead  '未読
    Cells(lrow, 4) = tmail.Body   '本文
    tmail.UnRead = False '***
   End If
  Next
 Else '未読がなければ以下が表示される '****
  MsgBox "作成すべき教育記録はありません。", vbExclamation
 End If
 Set toldir = Nothing
    • good
    • 0

ANo1です。


スマホからなので方法だけになってしまいますが・・

> 『作成すべき~』が回数分出てくるため~~
#1にも書きましたように、ループ内で1件処理する毎にメッセージを出すようになっているためそのようになってしまいます。
多分、なさりたいことは未読が1件もなかった時だけ表示したいのではないかと想像します。
そのような場合によく用いられる方法として、処理を行ったかどうかのフラグ(変数)を設定しておきます。
現在のループ内のメッセージ表示処理をはずした上で、ループ内では、未読の処理を行ったらこのフラグをセットするようにしておいて、ループを抜けてからフラグをチェックし、セットされていなかったら(=1度も処理していない)メッセージを出すようにすれば良いです。

でも、ご提示のコードの場合は、フラグに代わる指標がすでにあるので、フラグを設定する必要はありません。
ループ終了後に lrow の値を見れば、何件処理したか(しなかったか)がわかるので、『⚪件処理しました』とか『ありませんでした』といった表示をすることが可能ですね。


>抽出が終わった後は既読にしたい~~
メソッドの仕様は存じませんが、
 tmail.UnRead = False
で、既読にできるのであるなら、未読メールの処理を行っているところに、既読化の処理を追加しておけば良いはずです。
    • good
    • 0

#1さんと内容的には、同じですが、私なりに手を加えてみました。



>MsgBox "作成すべき教育記録はありません。"
この部分をどう活かしてよいのか、今のところわかりません。


'// 
 'データの表示エリアをクリアする
 ''Rows("6:9999").Delete Shift:=xlUp '6行目から削除する
 Intersect(ActiveSheet.UsedRange, Rows("6:9999")).ClearContents '*
 Range("A1").Select
 'Outlookのインスタンスを作成
 Set tol = New Outlook.Application
 '名前空間を取得
 Set tns = tol.GetNamespace("MAPI")
 '○○○自動配信メールのフォルダを取得
 Set toldir = tns.GetDefaultFolder(olFolderInbox).Folders("○○○自動配信メール")
  ' 未読のメールのみに処理を行なう
 'If tmail.UnRead = True Then '*
  '項目名の表示
  lrow = 6
  Cells(lrow, 2) = "件名"
  Cells(lrow, 3) = "未読"
  Cells(lrow, 4) = "本文"  
  'アイテム数をループする
  For i = 1 To toldir.Items.Count
   'アイテムオブジェクト
   Set tmail = toldir.Items.Item(i)
   If tmail.UnRead Then '*
   lrow = lrow + 1
   '件名
   Cells(lrow, 2) = tmail.Subject
   '未読
   Cells(lrow, 3) = tmail.UnRead
   '本文
   Cells(lrow, 4) = tmail.Body
   End If '**
  Next
 'End If
 Set toldir = Nothing
 Set tns = Nothing
 Set tol = Nothing
    • good
    • 0

こんにちは



Outlookの制御はわかりませんが、ご提示のコードで構文的におかしそうな点を。

1)Forループの終りが不明。Next iがない。
2)If tmail.UnRead = True Thenの位置が変。
 ・オブジェクトtmailに代入される前に参照している。
 ・ループとの関係が包含関係にないように見える。

ひとまず、
If tmail.UnRead = True Then を
Set tmail = toldir.Items.Item(i) の後に移動して、
End If の後ろに Next i を入れたらどうでしょうか?

ただし、1件処理する毎に既読の場合にはメッセージが出るので、質問者様が意図なさっている動作とは違うのかもしれませんが。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!