【Accessをメール検索GUIとして使う02】csvベースのテーブルから検索ワードでアイテムを絞り込む【SQL】

https://qiita.com/taleau/items/f675fc0441fa75439127

前回の続き

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/281933/9c817404-a54d-c3d5-5e01-f49eea78b15c.png)

前回は詳細フォームでしたが、今回は詳細は置いといて超簡易的なメール検索フォームを作りました。
検索結果をダブルクリックするとメールアイテムをOutlookで開きます。

## フォーム作成

空のフォームを作成し、下図のように配置、命名します。
検索ワードを増やしたければ好きなだけ増やしてOKです。
どうせSQL構文にANDで追加していくだけなので。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/281933/bf984312-f968-fed0-4be4-60c0739f015d.png)

`lst検索結果`の列設定をしてあげます。
SQLで抽出する要素数に合わせて列設定してあげます。
幅は適当です。

今回は`strSQL = "SELECT EntryID,件名,本文,受信日時,添付ファイル,送信者名,受信者名,CC "`なので8列です。

列見出しは「はい」にしておきましょう

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/281933/2f94c4b8-8060-09f1-ffa7-2ff30e3d0765.png)


## コード

各フィールドに対して検索ワードをAND条件にしてSQLにかけてリストで吐き出させるだけの超簡単なもの。
リスト上の選択アイテムの詳細を表示するのとかはおいおい。

`Enum clm`のところは元のテーブルのフィールド順ではなく、SQLの`SELECT`の出力構成に合わせて設定する必要があるので要注意です。今回はEntryIDしか使いませんでしたが、選択アイテムの詳細を別のテキストボックスに表示する等したい場合には他のフィールド名もここで列挙しておくと楽だと思います。

``` vb
Option Compare Database
Option Explicit

Enum clm
  EntryID = 0
  件名
  本文
  受信日時
  添付ファイル
  送信者名
  受信者名
  CC
End Enum

Rem ==========================================
Rem メール検索
Rem ==========================================

' イベント部分
Private Sub txtKW件名_AfterUpdate()
  Call 検索結果を更新する
End Sub
Private Sub txtKW送信者_AfterUpdate()
  Call 検索結果を更新する
End Sub
Private Sub txtKW添付ファイル名_AfterUpdate()
  Call 検索結果を更新する
End Sub
Private Sub txtKW本文_AfterUpdate()
  Call 検索結果を更新する
End Sub

' メイン部分
Private Sub 検索結果を更新する()
  Dim strSQL As String
  
  Dim KW件名 As String
  Dim KW本文 As String
  Dim KW送信者 As String
  Dim KW添付ファイル名 As String
  
  KW件名 = Null対策(Me.txtKW件名.Value)
  KW本文 = Null対策(Me.txtKW本文.Value)
  KW送信者 = Null対策(Me.txtKW送信者.Value)
  KW添付ファイル名 = Null対策(Me.txtKW添付ファイル名.Value)
  
  strSQL = "SELECT EntryID,件名,本文,受信日時,添付ファイル,送信者名,受信者名,CC "
  strSQL = strSQL & "FROM MT_MailItems "
  strSQL = strSQL & "WHERE 件名 LIKE '*" & KW件名 & "*' "
  strSQL = strSQL & "AND 本文 LIKE '*" & KW本文 & "*' "
  strSQL = strSQL & "AND 送信者名 LIKE '*" & KW送信者 & "*' "
  strSQL = strSQL & "AND 添付ファイル LIKE '*" & KW添付ファイル名 & "*' "
  
  Me.lst検索結果.RowSource = strSQL
  
End Sub

Private Function Null対策(str) As String
' 空文字を結合させるだけでNull回避できる。一番シンプルなやつ
  Null対策 = str & ""
  
' IIfを使った場合
'  Null対策 = IIf(IsNull(str), "", str)

' 普通にIf文で書いた場合
' 上の1行は以下の5行と同義。IIf便利
'  If IsNull(str) = True Then
'    Null対策 = ""
'  Else
'    Null対策 = str
'  End If
End Function

Rem ==========================================
Rem メールアイテムを開く
Rem ==========================================

' イベント部分
Private Sub lst検索結果_DblClick(Cancel As Integer)
  Stop
  Dim rr As Long: rr = lst検索結果.ItemsSelected(0)
  Dim EntryID As String: EntryID = lst検索結果.Column(clm.EntryID, rr)
  Stop
  Call EntryIDからメールを開く(EntryID)
End Sub

' メイン部分
Sub EntryIDからメールを開く(EntryID As String)
  'appOLを呼び出す
  Dim appOL As Outlook.Application
  Set appOL = New Outlook.Application

  Dim objMailItem As MailItem 'GetItemFromIDメソッドでEntryIDからメールアイテムを抽出する
  Set objMailItem = appOL.GetNamespace("MAPI").GetItemFromID(EntryID)
  
  objMailItem.Display
    
  'オブジェクトをNothingしておく
  Set appOL = Nothing
  Set objMailItem = Nothing
    
End Sub


```