在庫管理

在庫管理システム-インポート&テーブルクリア

2022年10月19日

フォーム・F_テーブルクリア

Ver.2.10より、旧バージョンの在庫管理システムのAccessファイルからのテーブル読み込みとインポート機能について共通のフォームでできるようにしました。
フォームの名前などに先行して作ったテーブルクリアの名前が入っていますが、インポートと同様です。

メイン画面から「インポート」をクリックしたか、「テーブルクリア」をクリックしたかを変数に記憶しておき、処理を分けているだけです。

テーブルクリア

テーブルの内容(データ)をクリアします。
テーブルの構造は維持されます。
内容がクリアされても、インデックス(ID)はクリアされません。
クリア前がIDが100までのデータがあったとして、クリア後に新しいデータを記入しても、IDは101からになります。
もし、クリアしたテーブルのIDを1から始めたい場合にはテーブルのコピーを作成し、元のテーブルを削除。次にコピーされたテーブルの名前を元のテーブル名に戻せば可能です。VBAではできません。万一クエリにエラーが発生しますと直すのは面倒です。

クリアするテーブルにチェックを入れて実行します。プログラムからではなくAccessがテーブルを削除するにあたっての警告ポップアップが削除するテーブルの数だけ表示されます。これはVBAではどうしようもなく、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

-在庫管理