Excelからデータベースを更新する。

ADOを使って画面上の入力内容をデータベースに更新するサンプルです。
VBAでデータベースを更新するということは... それもマスタ登録系プログラムを作成するということは結構本格的なプログラムを用意しようという計画があるのだと思います。
1人で登録するためのプログラムであればこのページのような方法でも良いのでしょうが、 社内の多数の方に作成したプログラム(マクロが搭載されているワークブック)を配布するのであれば、 「配布の問題」が付いてくることを念頭に置いて下さい。 安易に手がけると後で問題が発生することになります。
本格的にプログラムを用意するのであれば、VisualBasic.NETで開発し、ClickOnceで現場配給させるような仕組みにした方が、後で苦労することが避けられます。
このページの説明はあくまでもサンプルとしてのものであって、この方法自体をお勧めしているわけではありません。
これは、配属マスタの変更を行なうというサンプルです。
環境はデータベース操作の最初の方のページからの延長になります。
ACCDBのサンプルはこのページの最後に用意してあります。

Accessのデータベースを更新するサンプル
(画像をクリックすると、このページのサンプルがダウンロードできます)

「配属登録変更.xlsm」を開きます。即座に、配属一覧が表示されます。
今回は一覧表示だけではなく、ここから社員コードの行を選択してその社員の部署や役職を変更するというサンプルです。
どれかの社員コードの行を選択すると、

Accessのデータベースを更新するサンプル

このように「配属情報の登録・変更」の画面が表示されます。
今回のサンプルは、データベース(MDB)への更新を行なうケースの説明のためのもので、あまり複雑な要素を持ち込みたくなかったので、社員コードあたりの部署・配属の変更の更新のみとしています。
配属マスタ(MST_HAIZOKU)は人事異動などの対応で開始日、終了日のフィールドを持っていますが、新しい開始日での追加登録の機能は盛り込んでおらず、先頭の開始日(入社日)時点のレコードの更新のみとなります。
「配属情報の登録・変更」の画面では、部署、役職がプルダウンで変更でき、「登録」ボタンのクリックで配属マスタ(MST_HAIZOKU)が更新されて、配属一覧のシートも合わせて更新されるようになっています。


以降はこのサンプルのソースコードの説明になります。

最初は「ThisWorkbook」です。
ThisWorkbook」では起動時のイベントで一覧表示を行なうことや、保存時に一覧表示をクリアなどを行ないます。

'***************************************************************************************************
'   ADOでAccessデータベースを更新する                           ThisWorkbook(Class)
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   [参照設定]
'   ・Microsoft Active Data Object 2.x Library(2.8 or Later)
'***************************************************************************************************
' 変更日付 Rev   変更履歴内容---------------------------------------------------------------------->
' 16/12/31(1.0.0)新規作成
'***************************************************************************************************
Option Explicit

'***************************************************************************************************
'   ■■■ ワークブックイベント ■■■
'***************************************************************************************************
'* 処理名 :Workbook_BeforeSave
'* 機能  :ブックの保存前イベント
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    '-----------------------------------------------------------------------------------------------
    ' シート初期化
    Call GP_ClearSheet(ThisWorkbook.Worksheets(1))
    ThisWorkbook.Worksheets(1).Range("$A$1").Select
End Sub

'***************************************************************************************************
'* 処理名 :Workbook_Open
'* 機能  :ブックを開く
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:本ブックと同じフォルダにある「SampleCorp1.mdb」から配属データを取得してシートに展開
'* 注意事項:
'***************************************************************************************************
Private Sub Workbook_Open()
    '-----------------------------------------------------------------------------------------------
    Dim dbCon As ADODB.Connection                                   ' ADODB.Connection
    Dim dbRes As ADODB.Recordset                                    ' ADODB.Recordset
    Dim objSh As Worksheet                                          ' Excel.Worksheet
    Dim strSQL As String                                            ' SQL文編集WORK
    Dim strToday As String                                          ' SQL文本日編集WORK
    Dim lngRow As Long                                              ' 行INDEX
    '-----------------------------------------------------------------------------------------------
    ' データベースへの接続
    If Not FP_GetSqlConnection(dbCon) Then Exit Sub
    '-----------------------------------------------------------------------------------------------
    ' 参照SQL文の編集・発行
    strToday = "#" & Format(Date, "yyyy-MM-dd") & "#"
    strSQL = FP_GetSqlCommon
    strSQL = strSQL & " WHERE S.[NYUSYA_YMD]<=" & strToday
    strSQL = strSQL & " AND (S.[TAISYOKU_YMD] IS NULL OR S.[TAISYOKU_YMD]>" & strToday & ")"
    strSQL = strSQL & " ORDER BY H.[SCD];"
    ' 参照SQL文の発行
    Set dbRes = New ADODB.Recordset
    dbRes.Open strSQL, dbCon, adOpenKeyset, adLockReadOnly
    '-----------------------------------------------------------------------------------------------
    ' 画面描画更新停止
    Call GP_StopSCUPD
    ' シート初期化
    Set objSh = ThisWorkbook.Worksheets(1)
    Call GP_ClearSheet(objSh)
    '-----------------------------------------------------------------------------------------------
    lngRow = 1
    ' 先頭レコードからEOFまで繰り返す
    Do Until dbRes.EOF
        ' 行を加算
        lngRow = lngRow + 1
        ' 一覧シート1行分の編集
        Call GP_SetSheetRow(objSh, dbRes, lngRow)
        ' 次のレコードに移る
        dbRes.MoveNext
    Loop
    '-----------------------------------------------------------------------------------------------
    ' レコードセット、データベース接続を閉じる
    dbRes.Close
    Set dbRes = Nothing
    dbCon.Close
    Set dbCon = Nothing
    ' 画面描画更新復帰
    Call GP_StartSCUPD
    Range("$A$1").Select
    ' 保存済み状態にする
    ThisWorkbook.Saved = True
End Sub

'------------------------------------------<< End of Source >>--------------------------------------
途中の共用できる各機能は標準モジュールに実装させて呼び出しているので、後述します。

次は「Sheet1」です。
Sheet1」で行なっているのは、シート上のセルを選択した時にその行の社員コードについての登録変更画面を表示させます。
登録変更画面で更新が行なわれた時は、当該行だけをデータベース(MDB)から参照し直して一覧表示も更新させます。

'***************************************************************************************************
'   ADOでAccessデータベースを更新する                           Sheet1(Class)
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   [参照設定]
'   ・Microsoft Active Data Object 2.x Library(2.8 or Later)
'***************************************************************************************************
' 変更日付 Rev   変更履歴内容---------------------------------------------------------------------->
' 16/12/31(1.0.0)新規作成
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private g_lngFormLeft As Long                                   ' フォーム位置(横)
Private g_lngFormTop As Long                                    ' フォーム位置(縦)

'***************************************************************************************************
'   ■■■ ワークシートイベント ■■■
'***************************************************************************************************
'* 処理名 :Worksheet_SelectionChange
'* 機能  :選択セル変更イベント
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    '-----------------------------------------------------------------------------------------------
    ' 複数セル選択自は無視
    If Target.Count > 1 Then Exit Sub
    ' 2行目以降でA列に社員コードがあることが条件
    If Target.Row < 2 Or Cells(Target.Row, 1).Value = "" Then Exit Sub
    '-----------------------------------------------------------------------------------------------
    Dim lngRow As Long                                          ' 行INDEX
    Dim strScd As String                                        ' 社員コード
    Dim blnReturnValue As Boolean                               ' 処理結果
    lngRow = Target.Row
    strScd = Cells(lngRow, 1).Value
    With FRM_HAIZOKU
        ' 表示位置の再現
        If ((g_lngFormLeft <> 0) Or (g_lngFormTop <> 0)) Then
            .StartUpPosition = 0
            .Left = g_lngFormLeft
            .Top = g_lngFormTop
        Else
            .StartUpPosition = 2
        End If
        .prpScd = strScd
        .Show
        ' 結果と表示位置を退避
        blnReturnValue = .prpReturnValue
        g_lngFormLeft = .Left
        g_lngFormTop = .Top
    End With
    ' 登録されていたら一覧を更新(対象行のみ)
    If blnReturnValue Then
        Call GP_UpdateRow(lngRow, strScd)
    End If
End Sub

'***************************************************************************************************
'   ■■■ サブ処理 ■■■
'***************************************************************************************************
'* 処理名 :GP_UpdateRow
'* 機能  :一覧行の更新
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = 行INDEX(Long)
'*      Arg2 = 社員コード(String)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_UpdateRow(ByVal lngRow As Long, ByVal strScd As String)
    '-----------------------------------------------------------------------------------------------
    Dim dbCon As ADODB.Connection                                   ' ADODB.Connection
    Dim dbRes As ADODB.Recordset                                    ' ADODB.Recordset
    Dim strSQL As String                                            ' SQL文編集WORK
    '-----------------------------------------------------------------------------------------------
    ' データベースへの接続
    If Not FP_GetSqlConnection(dbCon) Then Exit Sub
    '-----------------------------------------------------------------------------------------------
    ' 参照SQL文の編集・発行
    strSQL = FP_GetSqlCommon
    strSQL = strSQL & " WHERE H.[SCD]='" & strScd & "'"
    strSQL = strSQL & " ORDER BY H.[KAISHI_YMD] DESC;"
    ' 参照SQL文の発行
    Set dbRes = New ADODB.Recordset
    dbRes.Open strSQL, dbCon, adOpenKeyset, adLockReadOnly
    '-----------------------------------------------------------------------------------------------
    ' 一覧シート1行分の編集
    Call GP_SetSheetRow(Me, dbRes, lngRow)
    '-----------------------------------------------------------------------------------------------
    ' レコードセット、データベースを閉じる
    dbRes.Close
    Set dbRes = Nothing
    dbCon.Close
    Set dbCon = Nothing
    ' 保存済み状態にする
    ThisWorkbook.Saved = True
End Sub

'------------------------------------------<< End of Source >>--------------------------------------

次は「登録変更画面(FRM_HAIZOKU)」です。
上記シートの「Worksheet_SelectionChange」イベント内から呼び出される「登録変更画面(FRM_HAIZOKU)」です。
初回表示時は部署コンボリスト、役職コンボリストの生成を行ない、引き渡された社員コードの配属情報を表示させます。
登録ボタンの処理では変更された部署コード、役職コードについて配属マスタ(MST_HAIZOKU)への更新を行ない、呼び出し元へは更新の有無のみ通知します。

'***************************************************************************************************
'   ADOでAccessデータベースを更新する                           FRM_HAIZOKU(UserForm)
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   [参照設定]
'   ・Microsoft Active Data Object 2.x Library(2.8 or Later)
'***************************************************************************************************
' 変更日付 Rev   変更履歴内容---------------------------------------------------------------------->
' 16/12/31(1.0.0)新規作成
'***************************************************************************************************
Option Explicit
'===================================================================================================
' 共通定数
Private Const g_cnsTitle As String = "配属情報の登録・変更"
'---------------------------------------------------------------------------------------------------
' 状態制御
Private g_blnFirstShown As Boolean                                  ' 初回表示判定
'---------------------------------------------------------------------------------------------------
' 受け渡し変数
Private g_strScd As String                                          ' 社員コード
Private g_blnReturnValue As Boolean                                 ' 処理結果
'---------------------------------------------------------------------------------------------------
' 読み出し時点の各コード退避
Private g_strPrevBusyoCd As String                                  ' 部署コード
Private g_strPrevYakuCd As String                                   ' 役職コード
'---------------------------------------------------------------------------------------------------
' コンボリストに対応したコードテーブル
Private g_tblBusyoCd() As String                                    ' 部署コードテーブル
Private g_tblYakuCd() As String                                     ' 役職コードテーブル

'***************************************************************************************************
'   ■■■ フォームイベント ■■■
'***************************************************************************************************
'* 処理名 :UserForm_Activate
'* 機能  :フォーム初期表示
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub UserForm_Activate()
    '-----------------------------------------------------------------------------------------------
    Dim dbCon As ADODB.Connection                                   ' ADODB.Connection
    g_blnReturnValue = False
    ' 登録ボタンは不活性にする
    BTN_OK.Enabled = False
    ' データベースへの接続
    If Not FP_GetSqlConnection(dbCon) Then
        Me.Hide
        Exit Sub
    End If
    ' 初回表示の場合はコンボ設定を行なう
    If g_blnFirstShown Then
        ' 部署コンボの初期登録
        Call GP_SetBusyoCombo(dbCon)
        ' 役職コンボの初期登録
        Call GP_SetYakuCombo(dbCon)
        g_blnFirstShown = False
    End If
    '-----------------------------------------------------------------------------------------------
    ' 対象者配属情報の表示
    Call GP_SetHaizokuInfo(dbCon)
    ' データベース接続を閉じる
    dbCon.Close
    Set dbCon = Nothing
    ' 登録ボタンは活性にする
    BTN_OK.Enabled = True
End Sub

'***************************************************************************************************
'* 処理名 :UserForm_Initialize
'* 機能  :フォーム初期化
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub UserForm_Initialize()
    '-----------------------------------------------------------------------------------------------
    g_blnFirstShown = True
End Sub

'***************************************************************************************************
'* 処理名 :UserForm_QueryClose
'* 機能  :フォーム閉鎖動作
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    '-----------------------------------------------------------------------------------------------
    ' ユーザー操作で閉じられる時はHideに切替え
    If CloseMode = vbFormControlMenu Then
        g_blnReturnValue = False
        Cancel = True
        Me.Hide
    End If
End Sub

'***************************************************************************************************
'   ■■■ コントロールイベント ■■■
'***************************************************************************************************
'* 処理名 :BTN_OK_Click
'* 機能  :「登録」ボタンイベント(Click)
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub BTN_OK_Click()
    '-----------------------------------------------------------------------------------------------
    Dim dbCon As ADODB.Connection                                   ' ADODB.Connection
    Dim dbCmd As ADODB.Command                                      ' ADODB.Command
    Dim strBusyoCd As String                                        ' 選択部署コード
    Dim strYakuCd As String                                         ' 選択役職コード
    Dim strSQL As String                                            ' SQL文編集WORK
    Dim blnUpdate As Boolean
    ' フォーム登録内容チェック
    If Not FP_CheckForm(strBusyoCd, strYakuCd) Then Exit Sub
    '-----------------------------------------------------------------------------------------------
    ' データベースへの接続
    If Not FP_GetSqlConnection(dbCon) Then
        Me.Hide
        Exit Sub
    End If
    ' 更新SQL文の編集
    strSQL = "UPDATE MST_HAIZOKU SET "
    ' 部署コードに変異があるか
    If strBusyoCd <> g_strPrevBusyoCd Then
        blnUpdate = True
        strSQL = strSQL & "BUSYO_CD='" & strBusyoCd & "'"
    End If
    ' 役職コードに変異があるか
    If strYakuCd <> g_strPrevYakuCd Then
        If blnUpdate Then
            strSQL = strSQL & ","
        End If
        strSQL = strSQL & "YAKU_CD='" & strYakuCd & "'"
    End If
    strSQL = strSQL & " WHERE [SCD]='" & g_strScd & "';"
    ' コマンド発行
    Set dbCmd = New ADODB.Command
    dbCmd.ActiveConnection = dbCon
    dbCmd.CommandText = strSQL
    dbCmd.Execute
    ' データベース接続を閉じる
    dbCon.Close
    Set dbCon = Nothing
    g_blnReturnValue = True
    Me.Hide
End Sub

'***************************************************************************************************
'   ■■■ サブ処理 ■■■
'***************************************************************************************************
'* 処理名 :FP_CheckForm
'* 機能  :フォーム登録内容チェック
'---------------------------------------------------------------------------------------------------
'* 返り値 :チェック成否(Boolean)
'* 引数  :Arg1 = 選択部署コード(String)
'*      Arg2 = 選択役職コード(String)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Function FP_CheckForm(ByRef strBusyoCd As String, ByRef strYakuCd As String) As Boolean
    '-----------------------------------------------------------------------------------------------
    Dim strMSG As String                                            ' メッセージ
    ' 部署コンボ
    If CBO_BUSYO.ListIndex < 0 Then
        Call GP_AppendMessage(strMSG, "「部署」が選択されていません。")
    Else
        ' 選択された部署コードを得る
        strBusyoCd = g_tblBusyoCd(CBO_BUSYO.ListIndex)
    End If
    ' 役職コンボ
    If CBO_YAKU.ListIndex < 0 Then
        Call GP_AppendMessage(strMSG, "「役職」が選択されていません。")
    Else
        ' 選択された役職コードを得る
        strYakuCd = g_tblYakuCd(CBO_YAKU.ListIndex)
    End If
    ' 変更あるか
    If ((strBusyoCd = g_strPrevBusyoCd) And (strYakuCd = g_strPrevYakuCd)) Then
        Call GP_AppendMessage(strMSG, "何も変更されていません。")
    End If
    '-----------------------------------------------------------------------------------------------
    If strMSG = "" Then
        FP_CheckForm = True
    Else
        MsgBox strMSG, vbExclamation, g_cnsTitle
        FP_CheckForm = False
    End If
End Function

'***************************************************************************************************
'* 処理名 :GP_SetBusyoCombo
'* 機能  :部署コンボの初期登録
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = ADODB.Connection(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_SetBusyoCombo(ByRef dbCon As ADODB.Connection)
    '-----------------------------------------------------------------------------------------------
    Dim dbRes As ADODB.Recordset                                    ' ADODB.Recordset
    Dim lngIx As Long                                               ' テーブル用INDEX
    Dim lngIxMax As Long                                            ' 〃上限
    Dim tblRec() As String                                          ' レコードテーブル
    Dim strSQL As String                                            ' SQL文編集域
    ' 参照SQL文の編集
    strSQL = "SELECT BUSYO_CD"                                      ' (00)部署コード
    strSQL = strSQL & ",BUSYO_NM"                                   ' (01)部署名
    strSQL = strSQL & " FROM MST_BUSYO"
    strSQL = strSQL & " ORDER BY BUSYO_CD;"
    ' 参照SQL文の発行
    Set dbRes = New ADODB.Recordset
    dbRes.Open strSQL, dbCon, adOpenKeyset, adLockReadOnly
    '-----------------------------------------------------------------------------------------------
    lngIxMax = dbRes.RecordCount - 1
    ReDim g_tblBusyoCd(lngIxMax), tblRec(lngIxMax)
    lngIx = -1
    ' 先頭レコードからEOFまで繰り返す
    Do Until dbRes.EOF
        lngIx = lngIx + 1
        g_tblBusyoCd(lngIx) = dbRes.Fields(0).Value
        tblRec(lngIx) = dbRes.Fields(0).Value & " " & dbRes.Fields(1).Value
        ' 次のレコードに移る
        dbRes.MoveNext
    Loop
    ' レコードセットを閉じる
    dbRes.Close
    Set dbRes = Nothing
    '-----------------------------------------------------------------------------------------------
    ' コンボに登録
    CBO_BUSYO.List() = tblRec
End Sub

'***************************************************************************************************
'* 処理名 :GP_SetYakuCombo
'* 機能  :役職コンボの初期登録
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = ADODB.Connection(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub GP_SetYakuCombo(ByRef dbCon As ADODB.Connection)
    '-----------------------------------------------------------------------------------------------
    Dim dbRes As ADODB.Recordset                                    ' ADODB.Recordset
    Dim lngIx As Long                                               ' テーブル用INDEX
    Dim lngIxMax As Long                                            ' 〃上限
    Dim tblRec() As String                                          ' レコードテーブル
    Dim strSQL As String                                            ' SQL文編集域
    ' 参照SQL文の編集
    strSQL = "SELECT YAKU_CD"                                      ' (00)部署コード
    strSQL = strSQL & ",YAKU_NM"                                   ' (01)部署名
    strSQL = strSQL & " FROM MST_YAKU"
    strSQL = strSQL & " ORDER BY YAKU_CD;"
    ' 参照SQL文の発行
    Set dbRes = New ADODB.Recordset
    dbRes.Open strSQL, dbCon, adOpenKeyset, adLockReadOnly
    '-----------------------------------------------------------------------------------------------
    lngIxMax = dbRes.RecordCount - 1
    ReDim g_tblYakuCd(lngIxMax), tblRec(lngIxMax)
    lngIx = -1
    ' 先頭レコードからEOFまで繰り返す
    Do Until dbRes.EOF
        lngIx = lngIx + 1
        g_tblYakuCd(lngIx) = dbRes.Fields(0).Value
        tblRec(lngIx) = dbRes.Fields(0).Value & " " & dbRes.Fields(1).Value
        ' 次のレコードに移る
        dbRes.MoveNext
    Loop
    ' レコードセットを閉じる
    dbRes.Close
    Set dbRes = Nothing
    '-----------------------------------------------------------------------------------------------
    ' コンボに登録
    CBO_YAKU.List() = tblRec
End Sub

'***************************************************************************************************
'* 処理名 :GP_SetHaizokuInfo
'* 機能  :対象者配属情報の表示
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = ADODB.Connection(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:このサンプルでは異動に関する考慮はしていません
'***************************************************************************************************
Private Sub GP_SetHaizokuInfo(ByRef dbCon As ADODB.Connection)
    '-----------------------------------------------------------------------------------------------
    Dim dbRes As ADODB.Recordset                                    ' ADODB.Recordset
    Dim strSQL As String                                            ' SQL文編集域
    ' 参照SQL文の編集
    strSQL = FP_GetSqlCommon
    strSQL = strSQL & " WHERE H.[SCD]='" & g_strScd & "'"
    strSQL = strSQL & " ORDER BY S.[NYUSYA_YMD] DESC;"
    ' 参照SQL文の発行
    Set dbRes = New ADODB.Recordset
    dbRes.Open strSQL, dbCon, adOpenKeyset, adLockReadOnly
    ' フォーム上に配置
    TXT_SCD.Text = g_strScd
    TXT_SNAME.Text = dbRes.Fields(1).Value
    TXT_NYUSYA_YMD.Text = dbRes.Fields(7).Value
    TXT_KAISHI_YMD.Text = dbRes.Fields(9).Value
    g_strPrevBusyoCd = dbRes.Fields(2).Value
    g_strPrevYakuCd = dbRes.Fields(4).Value
    CBO_BUSYO.ListIndex = FP_GetListIndex(g_strPrevBusyoCd, g_tblBusyoCd)
    CBO_YAKU.ListIndex = FP_GetListIndex(g_strPrevYakuCd, g_tblYakuCd)
    ' レコードセットを閉じる
    dbRes.Close
    Set dbRes = Nothing
End Sub

'***************************************************************************************************
'* 処理名 :FP_GetListIndex
'* 機能  :コードテーブルから該当INDEXを取得
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = 対象コード(String)
'*      Arg2 = コードテーブル(Array:String)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:このサンプルでは異動に関する考慮はしていません
'***************************************************************************************************
Private Function FP_GetListIndex(ByVal strCode As String, ByRef tblCode() As String) As Long
    '-----------------------------------------------------------------------------------------------
    Dim lngIx As Long                                               ' テーブル用INDEX
    FP_GetListIndex = -1
    Do While lngIx <= UBound(tblCode)
        If tblCode(lngIx) = strCode Then
            FP_GetListIndex = lngIx
            Exit Do
        End If
        ' 次へ
        lngIx = lngIx + 1
    Loop
End Function

'***************************************************************************************************
'   ■■■ プロパティ ■■■
'***************************************************************************************************
'   社員コード(String)
'---------------------------------------------------------------------------------------------------
Public Property Let prpScd(ByVal Value As String)
    g_strScd = Value
End Property

'===================================================================================================
' 処理結果(Boolean)
'---------------------------------------------------------------------------------------------------
Public Property Get prpReturnValue() As Boolean
    prpReturnValue = g_blnReturnValue
End Property

'------------------------------------------<< End of Source >>--------------------------------------

最後は共通関数等を収容するモジュール(ADO_Module4)です。
ここには複数箇所で共用される関数などが収容されていますが、特に重要なのは「データベースへの接続(FP_GetSqlConnection)」です。
データベースへの接続は必要の都度行ない、データ授受が完了したらすぐに切断させるため、数カ所から呼び出されます。 古くは開いた時点で接続し、閉じる段階で切断するような方法でレスポンスを維持させる対応を行なっていたようですが、現在の推奨はこのように都度接続・切断になっています。 この方法でもADO側の「接続プール」に実際の接続は安全な形で保持されているのでレスポンスは悪化しません。

'***************************************************************************************************
'   ADOでAccessデータベースを更新する                           ADO_Module4(Module)
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   [参照設定]
'   ・Microsoft Active Data Object 2.x Library(2.8 or Later)
'   ・Microsoft Scripting Runtime
'***************************************************************************************************
' 変更日付 Rev   変更履歴内容---------------------------------------------------------------------->
' 16/12/31(1.0.0)新規作成
'***************************************************************************************************
Option Explicit
Private Const g_cnsAdoConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='"
Private Const g_cnsMdbName = "SampleCorp1.mdb"

'***************************************************************************************************
'   ■■■ 共通サブ処理 ■■■
'***************************************************************************************************
'* 処理名 :FP_GetSqlConnection
'* 機能  :データベースへの接続
'---------------------------------------------------------------------------------------------------
'* 返り値 :処理成否(Boolean)
'* 引数  :Arg1 = ADODB.Connection(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Public Function FP_GetSqlConnection(ByRef dbCon As ADODB.Connection) As Boolean
    '-----------------------------------------------------------------------------------------------
    Dim objFso As FileSystemObject                                  ' FileSystemObject
    Dim strFilename As String                                       ' フルパスファイル名
    Dim strConnection As String                                     ' 接続文字列
    '-----------------------------------------------------------------------------------------------
    ' フルパスファイル名の編集
    Set objFso = New FileSystemObject
    strFilename = objFso.BuildPath(ThisWorkbook.Path, g_cnsMdbName)
    Set objFso = Nothing
    ' 接続文字列の編集
    strConnection = g_cnsAdoConnectString & strFilename & "';"
    '-----------------------------------------------------------------------------------------------
    On Error Resume Next
    ' 接続を確立する
    Set dbCon = New ADODB.Connection
    dbCon.Open strConnection
    ' クライアントカーソル設定(MDBでは関係ないかも)
    dbCon.CursorLocation = adUseClient
    ' 処理成否判定
    If Err.Number = 0 Then
        FP_GetSqlConnection = True
    Else
        MsgBox Err.Description, vbCritical, "データベースへの接続"
        FP_GetSqlConnection = False
    End If
    On Error GoTo 0
End Function

'***************************************************************************************************
'* 処理名 :FP_GetSqlCommon
'* 機能  :一覧参照用SQL文共通部編集
'---------------------------------------------------------------------------------------------------
'* 返り値 :一覧参照用SQL文共通部(String)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Public Function FP_GetSqlCommon() As String
    '-----------------------------------------------------------------------------------------------
    Dim strSQL As String                                            ' SQL文編集WORK
    strSQL = "SELECT H.[SCD]"                                       ' (00)社員コード
    strSQL = strSQL & ",S.[KANJI_SEI]+S.[KANJI_MEI]"                ' (01)氏名(漢字)
    strSQL = strSQL & ",H.[BUSYO_CD]"                               ' (02)部署コード
    strSQL = strSQL & ",B.[BUSYO_NM]"                               ' (03)部署名
    strSQL = strSQL & ",H.[YAKU_CD]"                                ' (04)役職コード
    strSQL = strSQL & ",Y.[YAKU_NM]"                                ' (05)役職名
    strSQL = strSQL & ",S.[KANA_SEI]+S.[KANA_MEI]"                  ' (06)氏名(カナ)
    strSQL = strSQL & ",S.[NYUSYA_YMD]"                             ' (07)入社日
    strSQL = strSQL & ",S.[TAISYOKU_YMD]"                           ' (08)退職日
    strSQL = strSQL & ",H.[KAISHI_YMD]"                             ' (09)開始日
    strSQL = strSQL & " FROM ((([MST_HAIZOKU] AS H"
    strSQL = strSQL & " INNER JOIN [MST_SYAIN] AS S ON H.[SCD]=S.[SCD])"
    strSQL = strSQL & " LEFT OUTER JOIN [MST_BUSYO] AS B ON H.[BUSYO_CD]=B.[BUSYO_CD])"
    strSQL = strSQL & " LEFT OUTER JOIN [MST_YAKU] AS Y ON H.[YAKU_CD]=Y.[YAKU_CD])"
    FP_GetSqlCommon = strSQL
End Function

'***************************************************************************************************
'* 処理名 :GP_ClearSheet
'* 機能  :シート初期化
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = Excel.Worksheet(Object)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Public Sub GP_ClearSheet(ByRef objSh As Worksheet)
    '-----------------------------------------------------------------------------------------------
    With objSh
        If .FilterMode Then .ShowAllData
        .Rows("2:" & .Rows.Count).ClearContents
    End With
End Sub

'***************************************************************************************************
'* 処理名 :GP_SetSheetRow
'* 機能  :一覧シート1行分の編集
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = Excel.Worksheet(Object)
'*      Arg2 = ADODB.Recordset(Object)
'*      Arg3 = 現在行(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Public Sub GP_SetSheetRow(ByRef objSh As Worksheet, _
                          ByRef dbRes As ADODB.Recordset, _
                          ByVal lngRow As Long)
    '-----------------------------------------------------------------------------------------------
    Dim lngCol As Long                                              ' 列INDEX
    ' 全列をシートに展開
    For lngCol = 0 To 8
        objSh.Cells(lngRow, lngCol + 1).Value = dbRes.Fields(lngCol).Value
    Next lngCol
End Sub

'***************************************************************************************************
'* 処理名 :GP_StopSCUPD
'* 機能  :画面描画更新停止
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Public Sub GP_StopSCUPD()
    '-----------------------------------------------------------------------------------------------
    With Application
        .ScreenUpdating = False
'        .EnableCancelKey = xlDisabled
        .Calculation = xlCalculationManual
'        .Interactive = False
'        .Cursor = xlWait
        .EnableEvents = False
    End With
End Sub

'***************************************************************************************************
'* 処理名 :GP_StartSCUPD
'* 機能  :画面描画更新復帰
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Public Sub GP_StartSCUPD()
    '-----------------------------------------------------------------------------------------------
    With Application
        If .Calculation <> xlCalculationAutomatic Then
            .Calculation = xlCalculationAutomatic
        End If
        .Cursor = xlDefault
        .EnableCancelKey = xlInterrupt
        .EnableEvents = True
        .Interactive = True
        .StatusBar = False
        .ScreenUpdating = True
    End With
End Sub

'***************************************************************************************************
'* 処理名 :GP_AppendMessage
'* 機能  :エラーメッセージ累積
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = 表示用累積メッセージ(String)
'*      Arg2 = 今回追加メッセージ(String)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2016年12月31日
'* 作成者 :井上 治
'* 更新日 :2016年12月31日
'* 更新者 :井上 治
'* 機能説明:改行を加えながらメッセージを追加する
'* 注意事項:
'***************************************************************************************************
Public Sub GP_AppendMessage(ByRef strMSG As String, ByRef strADDMSG As String)
    '-----------------------------------------------------------------------------------------------
    If strMSG <> "" Then strMSG = strMSG & vbCrLf
    strMSG = strMSG & strADDMSG
End Sub

'------------------------------------------<< End of Source >>--------------------------------------

ACCDBで実行したい方へ  
Accessのテーブルから取り込んだところ
(画像をクリックすると、このページのサンプルがダウンロードできます)

このページの先頭の画像のクリックからMDB版がダウンロードできますが、それと全く同じ構成でのACCDB版を用意しましたので必要な方がご覧下さい。
ファイル名の拡張子が「MDB」から「ACCDB」に変わるのですが、ADOでは参照ライブラリには変更ありませんが、接続文字列の変更があります。 接続プロバイダの「Provider=Microsoft.Jet.OLEDB.4.0;」を「Provider=Microsoft.ACE.OLEDB.12.0;」に変更となります。
ソースコード上これ以外ではプロシージャタイトルやコメントなどの変更のみで同様に動作します。

Accessを持たない環境でMDB(ACCDB)を使いたい方へ   以下のようなツールをご用意していますので、合わせてご利用下さい。
MDB(ACCDB)生成/テーブル定義取得ツール」
  ⇒ワークシート上に登録したテーブル定義内容で実際にMDB(データベース)ファイルを作成したり、
    現存するMDB(データベース)ファイルの定義内容を取得するツールです。
MDB(ACCDB)データ取得ツール」
  ⇒SQL文の検証や、データの調査・修正を行なうツールです。