添付ファイル型（画像データ）のデータをテーブル間で移動させたい

###前提・実現したいこと
テーブル１に「フィールド１」（添付ファイル型）があり、そのテーブルから、テーブル２というテーブルの「FileData」（添付ファイル型）に画像を移動させたいです。（その逆も出来るようにしたい）

あるいは、テーブル１から画像のデータを消す。次に、それと同じ画像データをテーブル２に追加するということができるだけでも助かります。

###発生している問題・エラーメッセージ

データ型の変換エラーが発生しました 実行時エラー3421

###該当のソースコード

VBA
1      Set rst = CurrentDb.OpenRecordset("ゴミ箱", dbOpenTable)
2       With rst
3        .AddNew
4        .Fields("削除日付") = Now()
5        .Fields("削除ユーザ") = loginuser
6        .Fields("管理番号") = Me.管理番号
7        .Fields("物品名") = Me.物品名
8        .Fields("型番") = Me.型番
9        .Fields("数") = Me.数
10        .Fields("ファイル名") = Me.ファイル名
11        .Fields("棚") = Me.棚
12        .Fields("段数") = Me.段数
13        .Fields("箱") = Me.箱
14        .Fields("ハッシュ") = Me.ハッシュ
15        .Fields("備考") = Me.備考
16        .Fields("棚卸対象か") = Me.棚卸対象か
17        .Fields("警告するか") = Me.警告するか
18        .Fields("見つからない") = Me.見つからない
19        .Fields("最新取り出し日付") = Me.最新取り出し日付
20        .Fields("取り出し回数") = Me.取り出し回数
21        .Fields("MAP") = Me.MAP
22        .Fields("FileData").Value = !FileData.LoadFromFile(Me.フィールド１_FileData)
23        .Update
24       End With
25       
26      rst.Close
27      Set rst = Nothing
28      DoCmd.SetWarnings False
29      Me.AllowDeletions = True
30      DoCmd.RunCommand acCmdDeleteRecord
31      Me.AllowDeletions = False
32           
33      Me.Undo
34      Me.Requery
35      DoCmd.SetWarnings True

###試したこと
・.addNew → .Edit

・.Fields("FileData").Value = !FileData.LoadFromFile(Me.フィールド１_FileData)→それぞれにMe.やら直接画像のフルパスを入れたりしました。

###補足情報(言語/FW/ツール等のバージョンなど)
Access 2016

行動規範の内容に同意します

回答1件

ベストアンサー

添付ファイル型フィールドのデータ型は、「RecordSet2型」というもので、ようするにレコードセットで複数のデータを持てるようになっています。

下記で紹介されている CopyAttachmentField関数を使えば簡単にコピーできます。

Access 添付ファイル型のフィールド値のコピー方法(VBA) | SOHOプログラマのぼやき @Links[アットリンクス]

上記のリンク先から、CopyAttachmentField関数を標準モジュールにコピーして、private FunctionをPublic Functionに変更。

フォームの削除ボタンのクリック時を下記のように変更。

Private Sub cmdDel_Click()
    Dim rst As DAO.Recordset
    Set rst = CurrentDb.OpenRecordset("ゴミ箱", dbOpenTable)
    With rst
        .AddNew
        .Fields("削除日付") = Now()
   
        '中略

        '.Fields("FileData").Value = !FileData.LoadFromFile(Me.フィールド1_FileData)
        CopyAttachmentField Me.Recordset!FileData.Value, rst!FileData.Value
        .Update
    End With

    rst.Close
    Set rst = Nothing
    DoCmd.SetWarnings False
    Me.AllowDeletions = True
    DoCmd.RunCommand acCmdDeleteRecord
    Me.AllowDeletions = False

    '      Me.Undo
    '      Me.Requery
    DoCmd.SetWarnings True

End Sub

フォーム上の添付型フィールドを参照するときは、Me!FileData.Value ではなく Me.Recordset!FileData.Value とする必要があるようです。

CopyAttachmentField関数（リンク先よりコピーして一部変更）

'--------------------------------------------------
'概要 ： 添付ファイル型データをコピー
'--------------------------------------------------
'引数 ： rsFromTbl , I , DAo.Recordset , 待避元の添付ファイル型レコードセット
'     ： rsToTbl   , I , DAo.Recordset , 待避先の添付ファイル型レコードセット
'--------------------------------------------------
'戻り値： 成功 = True 失敗 = False
'--------------------------------------------------
Public Function CopyAttachmentField(ByVal rsFromTbl As DAO.Recordset2, ByVal rsToTbl As DAO.Recordset2) As Boolean
    Dim intField As Integer

    CopyAttachmentField = False '初期値は失敗

    On Error GoTo ERRTRAP

    'レコード終了まで処理
    Do Until rsFromTbl.EOF = True
        rsToTbl.AddNew '待避先に新規追加
        'フィールド分のデータをセットする
        For intField = 0 To rsFromTbl.Fields.Count - 1
            '待避先のフィールドが更新可能な場合
            If rsToTbl.Fields(intField).DataUpdatable = True Then
                '待避元のデータがNullではない場合
                If IsNull(rsFromTbl.Fields(intField).Value) = False Then
                    '待避先に待避元のデータをセットする
                    rsToTbl.Fields(intField).Value = rsFromTbl.Fields(intField).Value
                End If
            End If
        Next
        rsToTbl.Update '待避先を更新
        rsFromTbl.MoveNext
    Loop

    rsFromTbl.Close
    rsToTbl.Close

    Set rsFromTbl = Nothing
    Set rsToTbl = Nothing

    CopyAttachmentField = True 'ここまできたら成功

Exit Function
ERRTRAP:
    MsgBox "添付ファイル型データの追加中にエラーが発生しました" & vbCrLf _
        & "エラー番号:" & Err.Number & vbCrLf _
        & "エラー内容:" & Err.Description & vbCrLf, vbCritical, "予期せぬエラー"
End Function