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

参考サイトのサンプルをマネしながら少しだけ改造して、OutLookのメールをAccessのテーブル"tbl_mail"に取り込むVBAを書いてみました。

一度取り込んだメールは二度と取り込まない仕組みなのですが、実行してみると必ず1通だけ重複したメールを取り込んでしまいます。

対象フォルダは「個人用フォルダ」の中の「受信トレイ」の中の「集荷」です。

サンプルとして3通のメールを入れていますが、何度実行しても、

"新しいメールはありませんでした。"とはならずに、

"読込み1件・重複2件"となります。

最近ADOを勉強し始めたばかりで原因がさっぱりわかりません。
このサンプルに対する質問は検索してもほとんど見つけられませんでした。

よろしくお願いいたします。

Access2010(Win7)で作り、DBはUSBに保存して、Access2007(vista)でも使っています。

フォームのボタンで標準モジュールのFunction MailGetoを呼び出して実行しています。

Function MailGeto()

On Error GoTo エラー

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

Dim myNaSp As NameSpace
Dim myFolder As MAPIFolder
Dim mySecFolder As MAPIFolder
Dim myThrFolder As MAPIFolder
Dim myItem As MailItem
Dim myindex As Long, x As Long, y As Long, i As Long, r As Long
Dim MyCri As String

Set cn = Application.CurrentProject.Connection
Set rs = New ADODB.Recordset

rs.Open "tbl_mail", cn, adOpenKeyset, adLockOptimistic
Set myNaSp = GetNamespace("MAPI")

Set myFolder = myNaSp.GetDefaultFolder(olFolderInbox)

i = 0: r = 0

For x = 1 To myFolder.Folders.Count

Set mySecFolder = myFolder.Folders(x)

For myindex = 1 To mySecFolder.Items.Count
Set myItem = mySecFolder.Items(myindex)

'受信日時と件名をつなげた文字列を一意とする
MyCri = myItem.ReceivedTime & myItem.Subject

'条件…"tbl_mail"テーブルの"KEY"フールドの値と一致するもの
rs.Find "KEY='" & MyCri & "'"

If rs.EOF Then '検索条件と合致する物がない場合

rs.AddNew
rs!Key.Value = MyCri
rs.Fields("フォルダー").Value = mySecFolder
rs.Fields("受信日").Value = myItem.ReceivedTime
rs.Fields("送信者").Value = myItem.SenderName
rs.Fields("件名").Value = myItem.Subject
rs.Fields("メール").Value = myItem.SenderEmailAddress
rs.Fields("内容").Value = myItem.Body
rs.Update

i = i + 1 'メール件数を求めます。

Else
r = r + 1

End If
Next
Next

If i = 0 Then
MsgBox "新しいメールはありませんでした。"
Else

MsgBox "メールの更新が完了しました。" & Chr(13) & Chr(13) & _
"・読込み " & i & "件" & Chr(13) & _
"・重複 " & r & "件"
End If

rs.Close
cn.Close

Exit Function

エラー:

If Err.Number = 287 Then
MsgBox "書き出しを中止しました"
Else

MsgBox Err.Number & Err.Description
MsgBox "予期せぬエラーが発生しました"
End If

End Function

A 回答 (2件)

大変申し訳ありません。


私の勘違いだったようです。
検証結果、条件に合致しない場合には、EOF BOF ともに True になりました。
迷宮に入っていたのはヘルプを~@;}%した私でした。 orz

こちらでは何故か、主キー設定無し・全てのフィールドでインデックス無し
にしても機能しました?

>1つ目のメールアイテムに対して・・・
こちらです。
    • good
    • 0
この回答へのお礼

わざわざ調べていただいてありがとうございます。
おかげさまで自分なりにEOF BOFについて調べて、より深く理解することができました。

主キーについては謎のままですが、ADOで更に違うテーブルへレコードを書き移す際にも主キーがないとうまくいきませんでしたので、設定したままにしておきます。

>1つ目のメールアイテムに対して・・・
>こちらです。
なるほど、そうなんですね。
意味が分かってくると捗りますし楽しいです。

お忙しい中ありがとうございました。
次の機会があればまた宜しくお願いいたします。

お礼日時:2013/04/26 02:16

ここが迷宮の入り口かも?


>If rs.EOF Then '検索条件と合致する物がない場合
合致しない場合に、EOFにはならなくて最後のレコードに移動します。
ヘルプより
『カレント行の位置は、検出されたレコードに設定され、
条件を満たす行がない場合は、Recordset の最後 (または最初) に設定されます』
EOF は最後のレコードの【次】です。
『EOF カレント レコードの位置が Recordset オブジェクトの最後のレコードより後にあることを示します。』
なので、rs.EOF は常に不成立です。
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
DAOのレコードセットなら、NoMatch プロパティで簡単に調べられますので
DAOのレコードセットを使われるのが分かりやすいかと思います。
(Find でも Seek でも有効です)

ADO で、Rs.Recordcount = Rs.AbusolutePosition で最後のレコードか否かを判断できますが
最後のレコードに行った理由が
該当するレコードが無いため、か
たまたま最終レコードが該当したため、かは判別不能のような気がします。
(自信なさげ・・・)

この回答への補足

ありがとうございます。
実は回答を待つ間にテーブルのKEYフィールドに主キーを設定したところ、正常に作動しました。(理由はよくわからないままですが…)

>合致しない場合に、EOFにはならなくて最後のレコードに移動します。
読むほどにわからなくなってきたので少しご解説頂きたいのですが、上記rs.Find…の動作は、カレントレコードのフィールドの値1つに対してメールアイテムの最初から最後までを捜索するのか、1つ目のメールアイテムに対してフィールドの値の最初から最後までを捜索するのかどちらなんでしょうか。
自分では前者だと思っているのですが…。(トンデモ質問でしたらスミマセン)

補足日時:2013/04/25 01:32
    • good
    • 0
この回答へのお礼

すみません
OKwaveの利用は初めてなので…
ここへの入力をしていませんでした…

ありがとうございました。

お礼日時:2013/04/26 03:22

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

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