Access 添付ファイル型のフィールド値のコピー方法(VBA)

 Access2007で新しく追加されたデータ型の「添付ファイル型」のフィールド。

 「添付ファイル型」フィールドは、イメージ、ワークシート ファイル、ドキュメント、グラフ、およびサポートされている
その他の種類のファイルをデータベースのレコードに添付できるという使い方によっては便利なフィールド。

  ただこの「添付ファイル型」のフィールドを持ったテーブルをINSERT INTO~なSQLで処理することはできない仕様。
どうやら「添付ファイル型」が複数のファイルデータを格納しているからという理由っぽい。

 SQL文のみで対応できないのでVBAのコードによる処理で対応することに。
 そこで「添付ファイル型」のフィールド値をウォッチでチェックしてみると・・・「RecordSet2型」と表示されている。
「添付ファイル型」が複数のファイル情報を格納できるのは、それらをレコードとして格納しているからということか。

 コピー元のフィールド(RecordSet2型)をコピー先のフィールド(RecordSet2型)にレコード追加して、
各フィールドにデータをセットすることで「添付ファイル型」のコピーは対応できた。
 その場合、フィールドのDataUpdatableプロパティがTrueである項目のみ更新することに注意!
 例えば”FileTimeStamp”のフィールドは更新する必要が無い

 便利なフィールドだけど使用するときには注意しなければ。

以下は、添付ファイル型のフィールドをコピーするVBAのサンプル。

※サンプルコードの環境:Microsoft Access 2007 VBA

  1. '--------------------------------------------------
  2. '概要 : 添付ファイル型データをコピー
  3. '--------------------------------------------------
  4. '引数 : rsFromTbl , I , DAo.Recordset , 待避元の添付ファイル型レコードセット
  5. '  : rsToTbl , I , DAo.Recordset , 待避先の添付ファイル型レコードセット
  6. '--------------------------------------------------
  7. '戻り値: 成功 = True 失敗 = False
  8. '--------------------------------------------------
  9. Private Function CopyAttachmentField(ByVal rsFromTbl As DAO.Recordset2, ByVal rsToTbl As DAO.Recordset2) As Boolean
  10. Dim intField As Integer
  11.  
  12. CopyAttachmentField = False '初期値は失敗
  13.  
  14. On Error GoTo ERRTRAP
  15.  
  16. 'レコード終了まで処理
  17. Do Until rsFromTbl.EOF = True
  18. rsToTbl.AddNew '待避先に新規追加
  19. 'フィールド分のデータをセットする
  20. For intField = 0 To rsFromTbl.Fields.Count - 1
  21. '待避先のフィールドが更新可能な場合
  22. If rsToTbl.Fields(intField).DataUpdatable = True Then
  23. '待避元のデータがNullではない場合
  24. If IsNull(rsFromTbl.Fields(intField).value) = False Then
  25. '待避先に待避元のデータをセットする
  26. rsToTbl.Fields(intField).value = rsFromTbl.Fields(intField).value
  27. End If
  28. End If
  29. Next
  30. rsToTbl.Update '待避先を更新
  31. rsFromTbl.MoveNext
  32. Loop
  33.  
  34. rsFromTbl.Close
  35. rsToTbl.Close
  36.  
  37. Set rsFromTbl = Nothing
  38. Set rsToTbl = Nothing
  39.  
  40. CopyAttachmentField = True 'ここまできたら成功
  41.  
  42. Exit Function
  43. ERRTRAP:
  44. MsgBox "添付ファイル型データの追加中にエラーが発生しました" & vbCrLf _
  45. & "エラー番号:" & Err.Number & vbCrLf _
  46. & "エラー内容:" & Err.Description & vbCrLf, vbCritical, "予期せぬエラー"
  47. End Function

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

*