Access2016で添付ファイルを新規レコードに登録する方法がわからない。

Question

### 実現したいこと
Access2016の単票フォームにデータを表示させ、「保存」ボタンを押下すると、新規レコードとして登録したいのですが、添付ファイルがエラーになって登録できませんでした。
添付ファイルはどのようにしたら良いのでしょうか？

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

### 発生している問題・分からないこと
「顧客画像」が添付ファイルとなっています。
こちらがエラーで登録できない状態です。
「顧客画像」部分を削除すると登録できます。

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

```
Dim rst As New ADODB.Recordset
rst.Open "顧客リスト", CurrentProject.Connection, , adLockOptimistic
rst.AddNew
rst!お名前 = Me!お名前
rst!電話番号 = Me!電話番号
rst!顧客画像 = Me!顧客画像 ←ここがエラー
rst.Update
rst.Close
```

### 試したこと・調べたこと
- [x] teratailやGoogle等で検索した
- [ ] ソースコードを自分なりに変更した
- [ ] 知人に聞いた
- [ ] その他

##### 上記の詳細・結果
下記を見つけましたが、実現したい事と異なり、応用もわからず困っていました。

Private Sub cmd保存_Click()
'[保存]ボタンクリック時

'商品写真フィールドのレコードセットに対する操作
  With Me.Recordset!商品写真.Value
    Do Until .EOF
      If !FileName = Me!商品写真.FileName Then
        '現在表示されている添付ファイルを保存
        !FileData.SaveToFile "c:\Picture\data.jpg"
        Exit Do
      End If
      .MoveNext
    Loop
    .Close
  End With

End Sub

### 補足
特になし

Accepted Answer

> ・『フォームのカレントレコードが既存のレコードである状況』において、
> 　[複写]というコマンドボタンをクリックしたら、カレントレコードと
> 　同じ内容（主キーを除く）の新規レコード1件をテーブル[顧客リスト]に追加し、
> 　追加保存されたレコードをフォームのカレントレコードにする。

> 主キーはオートナンバー型になっており、それ以外のフィールドが複写

- テーブル[顧客リスト]の主キーはオートナンバー型のフィールド[ID]である。

-  テーブル[顧客リスト]をレコードソースとする連結フォームのフォームヘッダーセクション（またはフォームフッターセクション）上に、[複写コマンド]という名前のコマンドボタンが配置されている。

- レコードの複写に際し、クリップボードを仲介させない。

とりあえず、以上のような前提であると仮定した場合。

```vba
Private Sub 複写コマンド_Click()
On Error GoTo Err_複写コマンド_Click

Dim strErrTitle As String
    Dim strErrMsg As String

If Me.NewRecord = True Then
        strErrTitle = "レコード参照エラー"
        If Me.Dirty = True Then
            strErrMsg = "新規レコードの編集中です。"
        Else
            strErrMsg = "まだ編集が開始されていない新規レコードです。"
        End If
        MsgBox strErrMsg, _
               vbExclamation, _
               strErrTitle
        Exit Sub
    End If
    
    If Me.Dirty = True Then
        If MsgBox("カレントレコードの編集中です。このレコードを保存しますか？", _
                  vbYesNo + vbQuestion + vbDefaultButton2, _
                  "確認") = vbNo Then
            Exit Sub
        End If
    End If

'フォームのカレントレコードを保存
    DoCmd.RunCommand acCmdSaveRecord

If MsgBox("このレコードをコピーしますか？", _
              vbYesNo + vbQuestion + vbDefaultButton2, _
              "確認") = vbNo Then
        Exit Sub
    End If

Dim ws As DAO.Workspace
    Dim db As DAO.Database

Set ws = DBEngine.Workspaces(0)
    Set db = CurrentDb
    
    Dim rsSource As DAO.Recordset
    Dim rsDestination As DAO.Recordset
    Dim strSQL As String
    Dim lngSourceId As Long
    Dim lngNewId As Long
    
    lngSourceId = Me![ID].Value
    
    'コピー元となるレコードをテーブル[顧客リスト]から参照
    strSQL = "SELECT * FROM [顧客リスト] WHERE [ID] = " & lngSourceId & ";"
    Debug.Print strSQL
    Set rsSource = db.OpenRecordset(strSQL, dbOpenSnapshot)
    
    'コピー先として[顧客リスト]を（空のレコードセットとして）参照
    strSQL = "SELECT * FROM [顧客リスト] WHERE False;"
    Debug.Print strSQL
    Set rsDestination = db.OpenRecordset(strSQL, dbOpenDynaset)
    
    'トランザクション処理の開始
    ws.BeginTrans
    On Error GoTo RollBack_複写コマンド_Click
    
    With rsDestination
        '新規レコードの挿入
        .AddNew
        '[ID]と[顧客画像]（添付ファイル型）以外の全てのフィールドの値を複写
        ![お名前].Value = rsSource![お名前].Value
        ![電話番号].Value = rsSource![電話番号].Value
        'レコードの保存
        .Update
        '追加保存されたレコードにカーソルを戻す
        .MoveFirst
        'そのレコードのIDを取得
        lngNewId = ![ID].Value
    End With
    
    Dim rsSourceAttachments As DAO.Recordset
    Dim rsDestinationAttachments As DAO.Recordset
    
    'コピー元レコードの[顧客画像]をレコードセットとして参照
    Set rsSourceAttachments = rsSource![顧客画像].Value

'1つ以上のファイルが添付されている場合
    If Not rsSourceAttachments.EOF Then
        '追加保存されたレコードの[顧客画像]をレコードセットとして参照
        Set rsDestinationAttachments = rsDestination![顧客画像].Value

'追加保存されたレコードの再編集を開始
        rsDestination.Edit
        '全ての添付ファイルを追加
        Do Until rsSourceAttachments.EOF
            rsDestinationAttachments.AddNew
            rsDestinationAttachments![FileData].Value = rsSourceAttachments![FileData].Value
            rsDestinationAttachments![FileName].Value = rsSourceAttachments![FileName].Value
            rsDestinationAttachments.Update
            rsSourceAttachments.MoveNext
        Loop
        'レコードを保存
        rsDestination.Update
        Set rsDestinationAttachments = Nothing
    End If

Set rsSourceAttachments = Nothing
    
    'コミット
    ws.CommitTrans
    On Error GoTo Err_複写コマンド_Click
    
    'このフォームの再クエリ
    Me.Requery
    '追加されたレコードをカレントレコードに
    DoCmd.SearchForRecord acDataForm, Me.Name, , "[ID]=" & lngNewId

Exit_複写コマンド_Click:
On Error Resume Next
    
    Set rsSourceAttachments = Nothing
    Set rsDestinationAttachments = Nothing
    Set rsSource = Nothing
    Set rsDestination = Nothing
    Set db = Nothing
    Set ws = Nothing

Exit Sub

RollBack_複写コマンド_Click:
    'ロールバック
    ws.Rollback

Err_複写コマンド_Click:

strErrTitle = "実行時エラー (" & Me.Name & ".複写コマンド_Click)"
    strErrMsg = Err.Number & ": " & Err.Description
    
    Debug.Print strErrTitle
    Debug.Print strErrMsg
    
    MsgBox strErrMsg, vbCritical, strErrTitle
    
    Resume Exit_複写コマンド_Click
End Sub
```

Answer

一旦Streamに保存してから設定すると出来ました。

```vba

Dim Stream As ADODB.Stream
Set Stream = New ADODB.Stream
Stream.Type = adTypeBinary
Stream.Open
Stream.LoadFromFile Me!顧客画像.Picture

Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "顧客リスト", CurrentProject.Connection, adOpenDynamic, adLockOptimistic, adCmdTable
rs.AddNew
rs.Fields("顧客画像").Value = Stream.Read
rs.Update
rs.Close
Set rs = Nothing
```

Answer

質問へのコメントより
> ＞・『フォームのカレントレコードが既存のレコードである状況』において、
> ＞　[複写]というコマンドボタンをクリックしたら、カレントレコードと
> ＞　同じ内容（主キーを除く）の新規レコード1件をテーブル[顧客リスト]に追加し、
> ＞　追加保存されたレコードをフォームのカレントレコードにする。
> 引用テキスト
> 上記が実現したい内容です。
> 主キーはオートナンバー型になっており、それ以外のフィールドが複写できれば良いのですが。

そういうことなら、下記のコードでどうぞ。

```vba
Private Sub 複写_Click()
    DoCmd.RunCommand acCmdSelectRecord 'カレントレコードを選択
    DoCmd.RunCommand acCmdCopy 'コピー
    DoCmd.GoToRecord , , acNewRec '新規レコードへ移動
    DoCmd.RunCommand acCmdPasteAppend '追加貼り付け
End Sub
```
添付ファイルフィールドのデータもそのまま複写されます。
オートナンバー型のフィールドは自動で複写対象外になります。

質問がコメントで明確になったので以下は質問内容とは合致していません。
---

ADOの場合のコードは見つけられなかったですが、DAOなら下記が参考になるでしょう。

[DAO で添付ファイルを操作する | Microsoft Learn](https://learn.microsoft.com/ja-jp/office/vba/access/concepts/data-access-objects/work-with-attachments-in-dao)

**非連結フォームのテキストボックスにデータを入力してそれをテーブルに新規追加したいということなら、下記のようになります。**

```vba
Private Sub cmd保存_Click()
    '[保存]ボタンクリック時
    Dim rst As DAO.Recordset, rstPic As DAO.Recordset
    Set rst = CurrentDB.OpenRecordset("顧客リスト")
    rst.AddNew
    rst!お名前 = Me!お名前
    rst!電話番号 = Me!電話番号

'添付ファイル型フィールド（顧客画像）に画像ファイルを追加
    Set rstPic = rst!顧客画像.Value
    rstPic.AddNew 
    rstPic.Fields("FileData").LoadFromFile  Me!顧客画像 
    rstPic.Update

rst.Update
End Sub
```

添付ファイル型のValueは、DAOレコードセットというのがキモですね。

実現したいこと

発生している問題・分からないこと

該当のソースコード

試したこと・調べたこと

上記の詳細・結果

補足

質問がコメントで明確になったので以下は質問内容とは合致していません。

関連した質問