フォーム・F_テーブルクリア
Ver.2.10より、旧バージョンの在庫管理システムのAccessファイルからのテーブル読み込みとインポート機能について共通のフォームでできるようにしました。
フォームの名前などに先行して作ったテーブルクリアの名前が入っていますが、インポートと同様です。
メイン画面から「インポート」をクリックしたか、「テーブルクリア」をクリックしたかを変数に記憶しておき、処理を分けているだけです。
テーブルクリア
テーブルの内容（データ）をクリアします。
テーブルの構造は維持されます。
内容がクリアされても、インデックス（ID）はクリアされません。
クリア前がIDが100までのデータがあったとして、クリア後に新しいデータを記入しても、IDは101からになります。
もし、クリアしたテーブルのIDを1から始めたい場合にはテーブルのコピーを作成し、元のテーブルを削除。次にコピーされたテーブルの名前を元のテーブル名に戻せば可能です。VBAではできません。万一クエリにエラーが発生しますと直すのは面倒です。
クリアするテーブルにチェックを入れて実行します。プログラムからではなくAccessがテーブルを削除するにあたっての警告ポップアップが削除するテーブルの数だけ表示されます。これはVBAではどうしようもなく、Accessによるものです。警告が煩わしい場合にはAccessの設定を変更ください。「ファイル」-「オプション」-「クライアントの設定」から「アクションクエリ」のチェックを外します。
-
- Accessのオプション
インポート機能
テーブルクリアとの相違は、Accessファイルを読み込む前にポップアップにて注意書きが表示されます。
これに「はい」をクリックしますとファイル選択ダイアログが表示されます。ファイルを選択してください。
実行が完了しますとインポート完了のポップアップ画面が表示されます。
旧バージョンからのとは書いてありますが、同じバージョンのバックアップからでも、この後のバージョンからでも読み込めます。
追記ではなく、テーブル内容を消去してから書き込んでおりますが、追記のパターンも必要でしょうか？その場合は「DoCmd.RunSQL "DELETE FROM (テーブル名)"」の処理を実行しなければよいだけです。
現行バージョンにあって、読み込んだバージョンにはないテーブルやフィールドがあった場合の個別のエラー処理はしていません。ただ「On Error GoTo 終了」としてサブルーチンを抜けています。別のエラーが発生していた場合にも同様にルーチンを抜けてしまう可能性は残っています。
VBAコード
Ver.2.10
Option Compare Database
Option Explicit
'---------------------------------
'インポートのルーチンと共用にしました。
'---------------------------------
'---------------------------------
Private Sub Form_Load()
'---------------------------------
'サブルーチンFormInitはM_画面にあります
'---------------------------------
Call FormInit(Me.Form)
End Sub
'---------------------------------
Private Sub cmd_実行_Click()
On Error GoTo 終了
Dim objRec As ADODB.Recordset
'全てチェックされていなければ実行しない
If chk_ログイン履歴.Value = False And _
chk_検索履歴.Value = False And _
chk_入出庫処理.Value = False And _
chk_品目マスタ.Value = False And _
chk_社員マスタ.Value = False And _
chk_仕入先マスタ.Value = False And _
chk_保管場所.Value = False And _
chk_指図番号.Value = False And _
chk_サイド番号.Value = False And _
chk_入出庫コード.Value = False And _
chk_BOM.Value = False And _
chk_単位コード.Value = False And _
chk_各種設定.Value = False Then
Exit Sub
End If
Select Case lbl_タイトル.Caption
Case "インポート"
'---------------------------------
'以下のサブルーチンM_外部データベースにあります
'---------------------------------
If MsgBox("旧バージョンのデータベースファイルを選択してください。" & vbCr _
& "現在のテーブルを消去してインポートします。" & vbCr _
& "必ずバックアップを取って実行してください。" & vbCr _
& "よろしければYesをクリックしてください", vbYesNo) = vbYes Then
'---------------------------------
'サブルーチンADO_CONNECTIONはM_外部データベースにあります
'---------------------------------
If ADO_CONNECTION = False Then
MsgBox "インポートはキャンセルされました"
Exit Sub
End If
If chk_品目マスタ.Value = True Then Call 品目
If chk_社員マスタ.Value = True Then Call 社員
If chk_仕入先マスタ.Value = True Then Call 仕入先
If chk_単位コード.Value = True Then Call 単位
If chk_保管場所.Value = True Then Call 保管場所
If chk_入出庫コード.Value = True Then Call 入出庫
If chk_指図番号.Value = True Then Call 指図番号
If chk_サイド番号.Value = True Then Call サイド番号
If chk_入出庫処理.Value = True Then Call 入出庫処理
If chk_検索履歴.Value = True Then Call 検索クリア
If chk_ログイン履歴.Value = True Then Call ログイン履歴
'↓Ver.2.00より
'If chk_テーブル.Value = True Then Call テーブル
'If chk_マスタ更新履歴.Value = True Then Call マスタ更新履歴
If chk_各種設定.Value = True Then Call 各種設定
'↓Ver.2.10より
'---------------------------------
'サブルーチンBOMはM_外部データベースにあります
'---------------------------------
If chk_BOM.Value = True Then Call BOM
MsgBox ("インポートが完了しました")
'---------------------------------
'サブルーチンADO_DISCONNECTIONはM_外部データベースにあります
'---------------------------------
Call ADO_DISCONNECTION
End If
Case "テーブルクリア"
If MsgBox("レコードを削除してもよろしいですか？", vbYesNo) = vbYes Then
DoCmd.SetWarnings False
If chk_ログイン履歴.Value = True Then DoCmd.RunSQL "DELETE * FROM T_ログイン履歴"
If chk_検索履歴.Value = True Then DoCmd.RunSQL "DELETE * FROM T_検索履歴"
If chk_入出庫処理.Value = True Then DoCmd.RunSQL "DELETE * FROM T_入出庫処理"
If chk_品目マスタ.Value = True Then DoCmd.RunSQL "DELETE * FROM T_品目"
If chk_社員マスタ.Value = True Then DoCmd.RunSQL "DELETE * FROM T_社員"
If chk_仕入先マスタ.Value = True Then DoCmd.RunSQL "DELETE * FROM T_仕入先"
If chk_保管場所.Value = True Then DoCmd.RunSQL "DELETE * FROM T_保管場所"
If chk_指図番号.Value = True Then DoCmd.RunSQL "DELETE * FROM T_指図番号"
If chk_サイド番号.Value = True Then DoCmd.RunSQL "DELETE * FROM T_サイド番号"
If chk_入出庫コード.Value = True Then DoCmd.RunSQL "DELETE * FROM T_入出庫"
If chk_単位コード.Value = True Then DoCmd.RunSQL "DELETE * FROM T_単位"
If chk_BOM.Value = True Then DoCmd.RunSQL "DELETE * FROM T_BOM"
If chk_各種設定.Value = True Then DoCmd.RunSQL "DELETE * FROM T_各種設定"
MsgBox "削除しました"
DoCmd.Close
End If
End Select
Exit Sub
終了:
Call エラーログ("F_テーブルクリア", "cmd_実行_Click")
End Sub
'---------------------------------
Private Sub chk_all_Click()
If chk_all.Value = True Then
chk_ログイン履歴.Value = True
chk_検索履歴.Value = True
chk_入出庫処理.Value = True
chk_品目マスタ.Value = True
chk_社員マスタ.Value = True
chk_仕入先マスタ.Value = True
chk_保管場所.Value = True
chk_指図番号.Value = True
chk_サイド番号.Value = True
chk_入出庫コード.Value = True
chk_単位コード.Value = True
chk_BOM.Value = True
chk_各種設定.Value = True
Else
chk_ログイン履歴.Value = False
chk_検索履歴.Value = False
chk_入出庫処理.Value = False
chk_品目マスタ.Value = False
chk_社員マスタ.Value = False
chk_仕入先マスタ.Value = False
chk_保管場所.Value = False
chk_指図番号.Value = False
chk_サイド番号.Value = False
chk_入出庫コード.Value = False
chk_単位コード.Value = False
chk_BOM.Value = False
chk_各種設定.Value = False
End If
End Sub
'---------------------------------
Private Sub chk_ログイン履歴_Click()
If chk_ログイン履歴.Value = False Then chk_all.Value = False
End Sub
'---------------------------------
Private Sub chk_検索履歴_Click()
If chk_検索履歴.Value = False Then chk_all.Value = False
End Sub
'---------------------------------
Private Sub chk_入出庫処理_Click()
If chk_入出庫処理.Value = False Then chk_all.Value = False
End Sub
Private Sub chk_品目マスタ_Click()
If chk_品目マスタ.Value = False Then chk_all.Value = False
End Sub
'---------------------------------
Private Sub chk_仕入先マスタ_Click()
If chk_仕入先マスタ.Value = False Then chk_all.Value = False
End Sub
'---------------------------------
Private Sub chk_保管場所_Click()
If chk_保管場所.Value = False Then chk_all.Value = False
End Sub
'---------------------------------
Private Sub chk_指図番号_Click()
If chk_指図番号.Value = False Then chk_all.Value = False
End Sub
'---------------------------------
Private Sub chk_サイド番号_Click()
If chk_サイド番号.Value = False Then chk_all.Value = False
End Sub
'---------------------------------
Private Sub chk_入出庫コード_Click()
If chk_入出庫コード.Value = False Then chk_all.Value = False
End Sub
'---------------------------------
Private Sub chk_単位コード_Click()
If chk_単位コード.Value = False Then chk_all.Value = False
End Sub
'---------------------------------
Private Sub chk_BOM_Click()
If chk_BOM.Value = False Then chk_all.Value = False
End Sub
'---------------------------------
Private Sub chk_各種設定_Click()
If chk_各種設定.Value = False Then chk_all.Value = False
End Sub
'---------------------------------
Private Sub cmd_cancel_Click()
DoCmd.Close
End Sub
'---------------------------------
' マウスドラッグでフォーム移動
'---------------------------------
Private Sub フォームヘッダー_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And acLeftButton Then
ReleaseCapture
Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
'---------------------------------
Private Sub 詳細_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And acLeftButton Then
ReleaseCapture
Call SendMessage(Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
End Sub
