Accessの「添付ファイル型」ファイルを一括出力する

Accessには「添付ファイル型」という型があります。
ファイル選択したファイルをAccessに添付して使うことができて便利なのですが、多用するとAccessファイルが重くなりすぎるという問題があり相談を受けました。

＜やりたいこと＞
・添付ファイル型のデータを一括出力する
→所定のフォルダにキー情報と一緒に保管する
・保管したファイルパスを添付ファイル型ではなくテキスト型の項目に保管する
・フォームで表示する際に添付ファイルパスを使用して表示するよう変更する

テーブル準備

t_顧客管理テーブル

t_顧客管理をデータと構造毎コピーしてt_顧客管理newテーブルを作成します。
そのt_顧客管理newテーブルに「テキスト型」のimg_path_1～img_path_5まで項目を追加します。

t_顧客管理newテーブル

添付ファイル型のデータを一括出力して、ファイルパスを保管

下記のソースコードを実行すると添付型のファイルを外に出力して、それをnewテーブルにテキストpathを保管するということを行う事ができます。

Private Function funImegCheng() As Boolean
Dim rec As Recordset
Dim strSaveDir As String

Dim objRs As Recordset
Dim strSql As String
Dim strPath As String
Dim lngID As Long
Dim intNo As Integer

On Error GoTo Error

    funImegCheng = False
    Application.Echo False
    DoCmd.Hourglass True
    
    ' 出力ディレクトリ
    strSaveDir = Application.CurrentProject.Path & "\output\"
    ' ディレクトリ存在チェックをして存在しない時はフォルダを作成
    If Dir(strSaveDir, vbDirectory) = "" Then
        MkDir strSaveDir
    End If
    
    lngID = 0
    intNo = 1
    
    Set rec = CurrentDb.OpenRecordset("t_顧客管理")
    rec.MoveFirst
    
    Do Until rec.EOF
        With rec("画像").Value
            While Not .EOF
            
                If lngID <> rec("ID").Value Then
                    intNo = 1
                    lngID = rec("ID").Value
                Else
                    intNo = intNo + 1
                End If
            
                ' 画像保存path
                strPath = strSaveDir & rec("ID").Value & "_" & .Fields("FileName")
            
                ' 画像を出力
                .Fields("FileData").SaveToFile strPath
                
                strSql = "SELECT * FROM t_顧客管理new AS new_tbl WHERE new_tbl.id = " & rec("ID").Value
                Set objRs = CurrentDb.OpenRecordset(strSql, dbOpenDynaset)
                
                If objRs.RecordCount >= 1 Then
                    objRs.Edit
                    objRs.Collect("img_path_" & intNo) = strPath
                    objRs.Update
                End If
                
                ' 後処理
                objRs.Close: Set objRs = Nothing
                
                
                .MoveNext
            Wend
        End With
        rec.MoveNext
    Loop

    Set rec = Nothing
    
    funImegCheng = True
    
    Application.Echo True
    DoCmd.Hourglass False
    
    
Exit Function
Error:
    If Err.Number = 3839 Then
        Resume Next
    End If
    
    Application.Echo True
    DoCmd.Hourglass False
    MsgBox "エラーが発生しました。エラー内容：" & Err.Description & Chr$(10), vbCritical

End Function

objRs のSQLを見ると条件文にID＝と入れていることにより
IDとファイル名が一致するようになっています。

画面（フォーム）の修正

今まで添付ファイルを使用していた所をファイルパスを使用したフォームに修正します。

※項目は非連結で定義するのを推奨します（非連結フォーム）

コード例

Me.Controls("txt画像path" & i).Value = objRs.Fields("img_path_" & i)
Me.Controls("img画像" & i).Picture = objRs.Fields("img_path_" & i)
Me.Controls("img画像" & i).Visible = True

まとめ

添付ファイルを外出しに一括で出力してファイルパスを設定する方法をメインに記載しました。
そのあとのフォームでの使用方法については、用途によって色々と異なるので、ここでは割愛します。
画像のダブルクリックイベントで画像を大きく表示させたりすることも可能です。
その時に、画像が伸びたり縮んだりすることがあり、調べたら、イメージのプロパティで「OLEサイズ」というのがあるのですが、これをストレッチにすると元の画像が伸びたり縮んだりしなくて良かったです。