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

実現したいこと

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

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

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

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

該当のソースコード

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

試したこと・調べたこと

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

補足

特になし

sk.exe

2024/05/17 04:12

> 単票フォームにデータを表示・そのフォームは連結フォームであるか、それとも非連結フォームであるか。・そのフォームが連結フォームである場合、そのフォームのレコードソースはどのテーブルであるか。　（テーブル[顧客リスト]とは別のテーブルなのであれば、そのテーブルの名前は何なのか）とりあえず、以上の点について明記されることをお奨めします。少なくとも、添付ファイルコントロールは添付ファイル型のフィールドと連結させなければ機能しないため、非連結フォームでは無理です。

kaiichi

2024/05/17 06:24

ご回答ありがとうございます。フォームは連結フォームとなります。レコードソースと同じテーブル（顧客リスト）のデータを表示させて、同じテーブルに新規レコードとして登録したいです。レコードセレクタで新規レコードを選ぶと、空白のフォームになるので、そこに以前のデータを表示させて編集し、登録ボタンを押すと新規レコードに登録になるように出来ればうれしいのですが。添付ファイルが登録できない状態でした。よろしくお願い致します。

hatena19

2024/05/17 06:41

非連結フォームという前提で回答しましたが(連結フォームなら、新規レコード登録は基本的にVBA不要なので)。フォームの新規レコードにデータが表示できているなら、レコード移動やレコードセレクタをクリックなどのアクションを起こせば自動で登録できます。 > レコードセレクタで新規レコードを選ぶと、空白のフォームになるので、そこに以前のデータを表示させて編集し、登録ボタンを押すと新規レコードに登録になるように出来ればうれしいのですが。連結フォームの新規レコードで表示できているデータをコマンドボタンで保存するなら、 DoCmd.RunCommand acCmdSaveRecord の1行で可能です。問題は、新規レコードに「以前のデータを表示させて」の部分です。これをどのような操作で実現しているのでしょうか。あるいは実現できていないなら、どのようなUIで実現するつもりでしょうか。

sk.exe

2024/05/17 06:55

> レコードソースと同じテーブル（顧客リスト）のデータを表示させて、 > 同じテーブルに新規レコードとして登録 > レコードセレクタで新規レコードを選ぶと、空白のフォームになるので、 > そこに以前のデータを表示させて編集し、登録ボタンを押すと新規レコードに登録になるフォームのカレントレコードが新規レコードなのであれば、そのレコードに対する編集操作自体がテーブル[顧客リスト]に新規レコードを挿入することと同義です。その編集操作とは別に DAO.Recordset オブジェクトの AddNew メソッドを実行する必要はありません。なさりたいのは概ね「既存のレコードの内容を新規レコードに複写する（主キーを除く全てのフィールドの値を出力する）こと」だと思われますが、それを具体的にどのような状況下で実行することを想定されているかによって対応は変わってくるでしょう。・『フォームのカレントレコードが既存のレコードである状況』において、　[複写]というコマンドボタンをクリックしたら、カレントレコードと　同じ内容（主キーを除く）の新規レコード1件をテーブル[顧客リスト]に追加し、　追加保存されたレコードをフォームのカレントレコードにする。・『フォームのカレントレコードが新規レコードである状況』において、　ユーザーが指定した任意の条件に該当するレコード1件をテーブル[顧客リスト]から参照し、　そのレコードの内容（主キーを除く）をフォームのカレントレコードの各フィールドに代入する。主に以上のどちらに該当するのか、またテーブル[顧客リスト]に追加される新規レコードの主キーの値をどのように設定されるつもりなのかについて明記して下さい。（オートナンバー型のフィールドを主キーにしているのであれば、後者については無視して下さい）

kaiichi

2024/05/17 06:59

新規レコードに任意のデータを表示する技術があれば良いのかもしれませんね。レコードセレクタでデータを選択して、そのデータを修正してしまうと、あくまでレコードを修正するだけになってしまうので、修正したデータを新規レコードで登録したいのですが、何か方法はあるでしょうか？

kaiichi

2024/05/17 07:12

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

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

回答3件

ベストアンサー

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

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

テーブル[顧客リスト]の主キーはオートナンバー型のフィールド[ID]である。
テーブル[顧客リスト]をレコードソースとする連結フォームのフォームヘッダーセクション（またはフォームフッターセクション）上に、[複写コマンド]という名前のコマンドボタンが配置されている。
レコードの複写に際し、クリップボードを仲介させない。

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

vba
1Private Sub 複写コマンド_Click()
2On Error GoTo Err_複写コマンド_Click
3
4    Dim strErrTitle As String
5    Dim strErrMsg As String
6
7    If Me.NewRecord = True Then
8        strErrTitle = "レコード参照エラー"
9        If Me.Dirty = True Then
10            strErrMsg = "新規レコードの編集中です。"
11        Else
12            strErrMsg = "まだ編集が開始されていない新規レコードです。"
13        End If
14        MsgBox strErrMsg, _
15               vbExclamation, _
16               strErrTitle
17        Exit Sub
18    End If
19    
20    If Me.Dirty = True Then
21        If MsgBox("カレントレコードの編集中です。このレコードを保存しますか？", _
22                  vbYesNo + vbQuestion + vbDefaultButton2, _
23                  "確認") = vbNo Then
24            Exit Sub
25        End If
26    End If
27
28    'フォームのカレントレコードを保存
29    DoCmd.RunCommand acCmdSaveRecord
30
31    If MsgBox("このレコードをコピーしますか？", _
32              vbYesNo + vbQuestion + vbDefaultButton2, _
33              "確認") = vbNo Then
34        Exit Sub
35    End If
36
37    Dim ws As DAO.Workspace
38    Dim db As DAO.Database
39
40    Set ws = DBEngine.Workspaces(0)
41    Set db = CurrentDb
42    
43    Dim rsSource As DAO.Recordset
44    Dim rsDestination As DAO.Recordset
45    Dim strSQL As String
46    Dim lngSourceId As Long
47    Dim lngNewId As Long
48    
49    lngSourceId = Me![ID].Value
50    
51    'コピー元となるレコードをテーブル[顧客リスト]から参照
52    strSQL = "SELECT * FROM [顧客リスト] WHERE [ID] = " & lngSourceId & ";"
53    Debug.Print strSQL
54    Set rsSource = db.OpenRecordset(strSQL, dbOpenSnapshot)
55    
56    'コピー先として[顧客リスト]を（空のレコードセットとして）参照
57    strSQL = "SELECT * FROM [顧客リスト] WHERE False;"
58    Debug.Print strSQL
59    Set rsDestination = db.OpenRecordset(strSQL, dbOpenDynaset)
60    
61    'トランザクション処理の開始
62    ws.BeginTrans
63    On Error GoTo RollBack_複写コマンド_Click
64    
65    With rsDestination
66        '新規レコードの挿入
67        .AddNew
68        '[ID]と[顧客画像]（添付ファイル型）以外の全てのフィールドの値を複写
69        ![お名前].Value = rsSource![お名前].Value
70        ![電話番号].Value = rsSource![電話番号].Value
71        'レコードの保存
72        .Update
73        '追加保存されたレコードにカーソルを戻す
74        .MoveFirst
75        'そのレコードのIDを取得
76        lngNewId = ![ID].Value
77    End With
78    
79    Dim rsSourceAttachments As DAO.Recordset
80    Dim rsDestinationAttachments As DAO.Recordset
81    
82    'コピー元レコードの[顧客画像]をレコードセットとして参照
83    Set rsSourceAttachments = rsSource![顧客画像].Value
84
85    '1つ以上のファイルが添付されている場合
86    If Not rsSourceAttachments.EOF Then
87        '追加保存されたレコードの[顧客画像]をレコードセットとして参照
88        Set rsDestinationAttachments = rsDestination![顧客画像].Value
89
90        '追加保存されたレコードの再編集を開始
91        rsDestination.Edit
92        '全ての添付ファイルを追加
93        Do Until rsSourceAttachments.EOF
94            rsDestinationAttachments.AddNew
95            rsDestinationAttachments![FileData].Value = rsSourceAttachments![FileData].Value
96            rsDestinationAttachments![FileName].Value = rsSourceAttachments![FileName].Value
97            rsDestinationAttachments.Update
98            rsSourceAttachments.MoveNext
99        Loop
100        'レコードを保存
101        rsDestination.Update
102        Set rsDestinationAttachments = Nothing
103    End If
104
105    Set rsSourceAttachments = Nothing
106    
107    'コミット
108    ws.CommitTrans
109    On Error GoTo Err_複写コマンド_Click
110    
111    'このフォームの再クエリ
112    Me.Requery
113    '追加されたレコードをカレントレコードに
114    DoCmd.SearchForRecord acDataForm, Me.Name, , "[ID]=" & lngNewId
115
116Exit_複写コマンド_Click:
117On Error Resume Next
118    
119    Set rsSourceAttachments = Nothing
120    Set rsDestinationAttachments = Nothing
121    Set rsSource = Nothing
122    Set rsDestination = Nothing
123    Set db = Nothing
124    Set ws = Nothing
125
126    Exit Sub
127
128RollBack_複写コマンド_Click:
129    'ロールバック
130    ws.Rollback
131
132Err_複写コマンド_Click:
133
134    strErrTitle = "実行時エラー (" & Me.Name & ".複写コマンド_Click)"
135    strErrMsg = Err.Number & ": " & Err.Description
136    
137    Debug.Print strErrTitle
138    Debug.Print strErrMsg
139    
140    MsgBox strErrMsg, vbCritical, strErrTitle
141    
142    Resume Exit_複写コマンド_Click
143End Sub

投稿2024/05/17 09:00

sk.exe

総合スコア938

kaiichi

2024/05/20 00:07

ご連絡が遅くなりまして申し訳ございません。回答ありがとうございます。試したところ問題が解決しました！大変助かりました。私自身、初心者のため、頂いたコードがきちんと理解できていないのですが、頑張って勉強したいと思います。ベストアンサーに選ばせていただきました。

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

質問へのコメントより

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

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

vba
1Private Sub 複写_Click()
2    DoCmd.RunCommand acCmdSelectRecord 'カレントレコードを選択
3    DoCmd.RunCommand acCmdCopy 'コピー
4    DoCmd.GoToRecord , , acNewRec '新規レコードへ移動
5    DoCmd.RunCommand acCmdPasteAppend '追加貼り付け
6End Sub

添付ファイルフィールドのデータもそのまま複写されます。
オートナンバー型のフィールドは自動で複写対象外になります。

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

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

DAO で添付ファイルを操作する | Microsoft Learn

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

vba
1Private Sub cmd保存_Click()
2    '[保存]ボタンクリック時
3    Dim rst As DAO.Recordset, rstPic As DAO.Recordset
4    Set rst = CurrentDB.OpenRecordset("顧客リスト")
5    rst.AddNew
6    rst!お名前 = Me!お名前
7    rst!電話番号 = Me!電話番号
8
9    '添付ファイル型フィールド（顧客画像）に画像ファイルを追加
10    Set rstPic = rst!顧客画像.Value
11    rstPic.AddNew 
12    rstPic.Fields("FileData").LoadFromFile  Me!顧客画像 
13    rstPic.Update
14
15    rst.Update
16End Sub

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

投稿2024/05/17 03:52

編集2024/05/17 07:47

hatena19

総合スコア34053

kaiichi

2024/05/17 07:26

回答ありがとうございます。試してみましたが解決できませんでした。 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 を試してみたのですが、次の部分がエラーとなってしまいました。＞rstPic.Fields("FileData").LoadFromFile Me!顧客画像の部分で「実行時エラー'3421'　データ型の変換エラーが発生しました」となってしまいました。

kaiichi

2024/05/17 07:50

回答ありがとうございます。試してみましたが解決できませんでした。 Private Sub 複写_Click() DoCmd.RunCommand acCmdSelectRecord 'カレントレコードを選択 DoCmd.RunCommand acCmdCopy 'コピー DoCmd.GoToRecord , , acNewRec '新規レコードへ移動 DoCmd.RunCommand acCmdPasteAppend '追加貼り付け End Sub を試してみたのですが、添付ファイルだけがコピーされませんでした。

hatena19

2024/05/17 08:20

カレントレコードの添付ファイル型フィールドには間違いなく画像が登録されてますか。当方のサンプルでは問題なく添付ファイルもコピーされました。手作業で下記の操作をした場合は、どうなりますか。カレントレコードでレコードセレクタをクリック(レコード選択) リボンの「コピー」をクリック新規レコードへ移動リボンの「追加貼り付け」をクリック

kaiichi

2024/05/20 00:19

ご返信遅くなりまして申し訳ございません。＞手作業で下記の操作をした場合は、どうなりますか。＞カレントレコードでレコードセレクタをクリック(レコード選択) ＞リボンの「コピー」をクリック＞新規レコードへ移動＞リボンの「追加貼り付け」をクリックを行うと、IDだけが表示されました。リボンの「貼り付け」をクリックすると、IDと選択したフィールドだけがコピーになるようでした。これで何かわかるでしょうか？

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

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

vba
1
2Dim Stream As ADODB.Stream
3Set Stream = New ADODB.Stream
4Stream.Type = adTypeBinary
5Stream.Open
6Stream.LoadFromFile Me!顧客画像.Picture
7
8Dim rs As ADODB.Recordset
9Set rs = New ADODB.Recordset
10rs.Open "顧客リスト", CurrentProject.Connection, adOpenDynamic, adLockOptimistic, adCmdTable
11rs.AddNew
12rs.Fields("顧客画像").Value = Stream.Read
13rs.Update
14rs.Close
15Set rs = Nothing