データの追加・更新

  作成したテーブルにデータを挿入します。
  

  社員テーブル 

  部門テーブル

Excelの「社員テーブル」と「部門テーブル」を順番に開いて、データを挿入(追加)します。
既に挿入するデータが存在している場合は、データを更新します。

社員テーブルの社員番号と部門テーブルの部署コードは主キーに設定してあります。

主キーの設定は、テーブルの作成のここの部分です。
    DB_Cmd.CommandText = "CREATE TABLE 社員テーブル (" & _
                         "社員番号 INTEGER NOT NULL PRIMARY KEY," & _

主キーに求められる特性は
    ・重複していない
    ・NULL がないこと
です。

SELECT分で 同じ社員番号や部署コードがあるかチェックして、
    ・ない場合は INSERT（挿入・追加）
    ・ある場合は UPDATE（更新）
するように作成してあります。

Public Const ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="

Sub Insert_Update_Table()

    Dim DB_Connect                      As ADODB.Connection
    Dim DB_Cmd                          As ADODB.Command
    Dim DB_Record                       As ADODB.Recordset
    
    Dim MDB_Path                        As String
    Dim File_Path1                      As String
    Dim File_Path2                      As String
    Dim Prompt                          As String
    Dim File種類                        As String
    
    Dim Open_Workbook_Name              As String
    Dim i                               As Long
    Dim Max_Row                         As Long
    
    Const DB_Name = "Personnel.mdb"
    
    '各ファイルのパスを設定
    File種類 = "mdb (*.mdb),*mdb"
    Prompt = "「Personnel.mdb」を選択してください。"
    MDB_Path = Application.GetOpenFilename(File種類, , Prompt)

    File種類 = "Excel (*.xls;*.xlsx),*.xls;*.xlsx"
    Prompt = "「社員テーブル」を選択してください。"
    File_Path1 = Application.GetOpenFilename(File種類, , Prompt)

    Prompt = "「部門テーブル」を選択してください。"
    File_Path2 = Application.GetOpenFilename(File種類, , Prompt)
    

    Set DB_Connect = New ADODB.Connection
    
    DB_Connect.Open ConnectionString & MDB_Path & ";"

    Set DB_Cmd = New ADODB.Command

    DB_Cmd.ActiveConnection = DB_Connect
    
    Set DB_Record = New ADODB.Recordset
    DB_Record.ActiveConnection = DB_Connect

    '社員テーブルを開きます
    'Open_Target_File は別のTipsメニュ−で紹介
    Open_Target_File Open_Workbook_Name, File_Path1

    Max_Row = EffectiveRow
    
    For i = 2 To Max_Row
    
        DB_Record.Source = _
        "SELECT 社員番号  FROM 社員テーブル WHERE 社員番号 = " & Range("A" & i)
        
        DB_Record.Open
        
        If DB_Record.EOF Then
            'Range("A" & i) の社員番号が登録されていない
            
            DB_Cmd.CommandText = "INSERT INTO 社員テーブル VALUES(" & _
                  Range("A" & i) & " ,'" & Range("B" & i) & "'," & _
            "'" & Range("C" & i) & "','" & Range("D" & i) & "'," & _
            "'" & Range("E" & i) & "',#" & Range("F" & i) & "#," & _
                  Range("G" & i) & " )"

            DB_Cmd.Execute
        
        Else
            'Range("A" & i) の社員番号が登録されている
            
            DB_Cmd.CommandText = "UPDATE 社員テーブル SET " & _
            "名前        = '" & Range("B" & i) & "'," & _
            "よみ        = '" & Range("C" & i) & "'," & _
            "性別        = '" & Range("D" & i) & "'," & _
            "血液型      = '" & Range("E" & i) & "'," & _
            "生年月日    = #" & Range("F" & i) & "#," & _
            "部署コード  =  " & Range("G" & i) & "  " & _
            "WHERE 社員番号 = " & Range("A" & i)

            DB_Cmd.Execute
            
        End If
            
        DB_Record.Close

    Next
    Workbooks(Open_Workbook_Name).Close
    
    '部門テーブルを開きます
    'Open_Target_File は別のTipsメニュ−で紹介
    Open_Target_File Open_Workbook_Name, File_Path2

    Max_Row = EffectiveRow
    
    For i = 2 To Max_Row
    
        DB_Record.Source = _
       "SELECT 部署コード  FROM 部門テーブル WHERE 部署コード = " & Range("A" & i)
        
        DB_Record.Open
        
        If DB_Record.EOF Then
            'Range("A" & i) の部署コードが登録されていない
            
            DB_Cmd.CommandText = "INSERT INTO 部門テーブル VALUES(" & _
                  Range("A" & i) & " ,'" & Range("B" & i) & "'," & _
            "'" & Range("C" & i) & " ' )"

            DB_Cmd.Execute

        Else
            'Range("A" & i) の部署コードが登録されている
            
            DB_Cmd.CommandText = "UPDATE 部門テーブル SET " & _
            "部門名 = '" & Range("B" & i) & "', " & _
            "課名   = '" & Range("C" & i) & "'  " & _
            "WHERE 部署コード = " & Range("A" & i)

            DB_Cmd.Execute
        
        End If
        
        DB_Record.Close

    Next
    Workbooks(Open_Workbook_Name).Close
    
    Set DB_Record = Nothing
       
    Set DB_Cmd = Nothing
    
    DB_Connect.Close
    
    Set DB_Connect = Nothing
        
End Sub

  サンプル をダウンロードして、ご使用ください。