Accessには「添付ファイル型」という型があります。
ファイル選択したファイルをAccessに添付して使うことができて便利なのですが、多用するとAccessファイルが重くなりすぎるという問題があり相談を受けました。
<やりたいこと>
・添付ファイル型のデータを一括出力する
→所定のフォルダにキー情報と一緒に保管する
・保管したファイルパスを添付ファイル型ではなくテキスト型の項目に保管する
・フォームで表示する際に添付ファイルパスを使用して表示するよう変更する
テーブル準備
t_顧客管理テーブル
フィールド名 | データ型 | 説明 | |
PK | id | オートナンバー | |
画像 | 添付ファイル型 |
t_顧客管理をデータと構造毎コピーしてt_顧客管理newテーブルを作成します。
そのt_顧客管理newテーブルに「テキスト型」のimg_path_1~img_path_5まで項目を追加します。
余力を持ってMAX値を決めてimg_path_1~img_path_5まで作成しましたが
1つしか添付していない場合は、img_path_1のみで大丈夫です
t_顧客管理newテーブル
フィールド名 | データ型 | 説明 | |
PK | id | オートナンバー | |
画像 | 添付ファイル型 | ||
img_path_1 | 短いテキスト(255) | ||
img_path_2 | 短いテキスト(255) | ||
img_path_3 | 短いテキスト(255) | ||
img_path_4 | 短いテキスト(255) | ||
img_path_5 | 短いテキスト(255) |
添付ファイル型のデータを一括出力して、ファイルパスを保管
下記のソースコードを実行すると添付型のファイルを外に出力して、それを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.Collect(“img_path_” & intNo) = strPath
objRs のSQLを見ると条件文にID=と入れていることにより
IDとファイル名が一致するようになっています。
画面(フォーム)の修正
今まで添付ファイルを使用していた所をファイルパスを使用したフォームに修正します。
種類 | 名前 | |
1 | イメージ | img画像1 |
2 | テキストボックス | txt画像path1 |
3 | コマンドボタン | cmd画像選択1 |
4 | コマンドボタン | cmd画像削除1 |
※項目は非連結で定義するのを推奨します(非連結フォーム)
コード例
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サイズ」というのがあるのですが、これをストレッチにすると元の画像が伸びたり縮んだりしなくて良かったです。
コメント