ray88’s diary

お仕事で困ったとき用の自分用の覚書

トップ > サーバテーブルのデータをローカルテーブルへインポートする(部品）

サーバテーブルのデータをローカルテーブルへインポートする(部品）

※ページの一番下により効率よいコードに変更した部品改修版あり
■呼び出し元プロシージャ

Sub 読込テスト()
    Dim strResult As String
    strResult = fncImportTable("MT_社員マスタ", "W_社員マスタ", 4)
    Debug.Print strResult
End Sub

■呼び出し先
部品使用の前提条件：パブリック定数「DbConnectionString」にDBファイルのADO接続のConnectionStringを設定しておく
　（例）"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source="C:\デスクトップ\テストDB.accdb;" & _
"Jet OLEDB:Database Password=xxxx;"

Function fncImportTable(strDbTableName As String, strDstTableName As String, _
                        intColumn As Integer) As String
'--------------------------------------------------------------------------
'機能1：DBファイルのテーブルをアプリファイルのワークテーブルにインポートする
'前提条件：パブリック定数「DbConnectionString」にDBファイルのADO接続の
'　　　　　ConnectionStringを設定しておく
'引数1:インポート対象DBテーブル名
'引数2:インポート先ワークテーブル名
'引数3:インボートするカラムの総数
'戻り値:インポート結果の文字列
'--------------------------------------------------------------------------
    Dim CN As Object
    Dim CN2 As Object
    Dim RS As Object
    Dim RS2 As Object
'----------------------------------------------------------------------------
     Set CN = CreateObject("ADODB.Connection")
     Set RS = CreateObject("ADODB.Recordset")
     
     Set CN2 = CurrentProject.Connection
     Set RS2 = CreateObject("ADODB.Recordset")
' ----------------------------------------------------------------------------
On Error GoTo ErrHandler
'DBファイルに接続してレコードセットを取得
'DbConnectionStringはDBファイルのConnectionStringを格納した定数
    CN.Open = DbConnectionString
    'adOpenKeysetの値は1,adLockOptimisticの値は3
    RS.Open strDbTableName, CN, 1, 3
'------------------------------------------------------------------------------
'ローカルファイルのワークテーブルをレコードセットに格納
    'adOpenKeysetの値は1,adLockOptimisticの値は3
    RS2.Open strDstTableName, CN2, 1, 3
'------------------------------------------------------------------------------
 'DBファイルのデータをワークテーブルへインサート
    Do Until RS.EOF
        RS2.AddNew
        RS2.Fields(0) = RS.Fields(0)
        '★この箇所はインポートする項目数によって相違するのでカスタマイズ必要
        If intColumn > 1 Then
            RS2.Fields(1) = RS.Fields(1)
            RS2.Fields(2) = RS.Fields(2)
            RS2.Fields(3) = RS.Fields(3)
            RS2.Fields(4) = RS.Fields(4)
        End If
        RS2.Update
        RS.MoveNext
    Loop
'------------------------------------------------------------------------------
 '終了処理
    RS.Close: RS2.Close
    CN.Close: CN2.Close
    Set RS = Nothing: Set RS2 = Nothing
    Set CN = Nothing: Set CN2 = Nothing
    fncImportTable = "OK"
    Exit Function
ErrHandler:
    'RS2は更新モードのままではレコードセットを閉じられないのでCanelUpdateしてから
    '閉じる
    RS2.CancelUpdate
    RS.Close: RS2.Close
    CN.Close: CN2.Close
    Set RS = Nothing: Set RS2 = Nothing
    Set CN = Nothing: Set CN2 = Nothing
    fncImportTable = strDbTableName & "の読み込みに失敗しました"    
End Function

■回収修正版

Function fncImportTable2(strDbTableName As String, strDstTableName As String, _
                        intColumn As Integer) As String
'--------------------------------------------------------------------------
'機能1：DBファイルのテーブルをアプリファイルのワークテーブルにインポートする
'前提条件：パブリック定数「DbConnectionString」にDBファイルのADO接続の
'　　　　　ConnectionStringを設定しておく
'引数1:インポート対象DBテーブル名 またはSQL文
'引数2:インポート先ワークテーブル名
'引数3:インボートするカラムの総数
'戻り値:インポート結果の文字列
'--------------------------------------------------------------------------
    Dim CN As Object
    Dim CN2 As Object
    Dim RS As Object
    Dim RS2 As Object
'----------------------------------------------------------------------------
     Set CN = CreateObject("ADODB.Connection")
     Set RS = CreateObject("ADODB.Recordset")
     
     Set CN2 = CurrentProject.Connection
     Set RS2 = CreateObject("ADODB.Recordset")
' ----------------------------------------------------------------------------
On Error GoTo ErrHandler
'DBファイルに接続してレコードセットを取得
'DbConnectionStringはDBファイルのConnectionStringを格納した定数
    CN.Open = DbConnectionString
    'adOpenKeysetの値は1,adLockOptimisticの値は3
    RS.Open strDbTableName, CN, 1, 3
'------------------------------------------------------------------------------
'ローカルファイルのワークテーブルをレコードセットに格納
    'adOpenKeysetの値は1,adLockOptimisticの値は3
    RS2.Open strDstTableName, CN2, 1, 3
'------------------------------------------------------------------------------
 'DBファイルのデータをワークテーブルへインサート
    Dim i As Integer
    Do Until RS.EOF
        RS2.AddNew
        For i = 0 To intColumn - 1
            RS2.fields(i) = RS.fields(i)
        Next i
        RS2.Update
        RS.MoveNext
    Loop
'------------------------------------------------------------------------------
 '終了処理
    RS.Close: RS2.Close
    CN.Close: CN2.Close
    Set RS = Nothing: Set RS2 = Nothing
    Set CN = Nothing: Set CN2 = Nothing
    fncImportTable2 = "OK"
    Exit Function
ErrHandler:
    'RS2は更新モードのままではレコードセットを閉じられないのでCanelUpdateしてから
    '閉じる
    RS2.CanelUpdate
    RS.Close: RS2.Close
    CN.Close: CN2.Close
    Set RS = Nothing: Set RS2 = Nothing
    Set CN = Nothing: Set CN2 = Nothing
    fncImportTable2 = strDbTableName & "の読み込みに失敗しました"    
End Function