モジュールです。

  

Sub SP_7010_XLS2MDB(strGibNam As String, strMdbPath As String, strSheet As String, bolTopTitle As Boolean, strNewAdd As String)

'*************************************************************************************************

'@  指定されたエクセルブックから指定シートを  Accesへ変換する   例) a.xls ---> a.mdb

'*  [INPUT]    strGibNam AS STRING            '==対象データファイル名(インポートするExcel ファイル)   例) D:\TEST\DATA.XLSX

'*             strMdbPath AS STRING           '==Accesのパス(存在している必用がある)                  例) D:\TEST\Database1.accdb

'*             strSheet AS STRING             '==対象のシート名                                       例) お客様マスタ

'*             bolTopTitle As Boolean         '==TRUE(先頭行をフィールド名として扱う)    FALSE;先頭行はフィールド名ではない

'*             strNewAdd  As String           '=="NEW":新しいテーブルとして（既存データがあれば消される) "NEW"以外はテーブルにデータが既にあればデータ追加となる

'*************************************************************************************************

Dim objAccess As Object

'

'***準備/MDB OPEN

    Set objAccess = CreateObject("Access.Application")

    objAccess.OpenCurrentDatabase strMdbPath

  

'***入れ替えの場合

    If strNewAdd = "NEW" Then                     '=="NEW":新しいテーブルとして（既存データがあれば消される) "ADD":テーブルが既にあればデータ追加となる

       On Error Resume Next

       objAccess.DoCmd.DeleteObject 0, strSheet

       On Error Resume Next

     End If

'

'***インポート

     objAccess.DoCmd.TransferSpreadsheet 0, , strSheet, strGibNam, bolTopTitle, strSheet & "!"

'

'***後始末

    objAccess.DoCmd.Close

    objAccess.Quit

    Set objAccess = Nothing

'

'***EXIT

    Exit Sub

End Sub

  

テスト用メインです

Sub TestMain()

'*****************************************************

'@ SP_7010_XLS2MDBのテスト用メイン

'*****************************************************

Dim strGibNam As String                                                            '==対象データファイル名(インポートするExcel ファイル) 例) D:\TEST\DATA.XLSX

Dim strMdbPath As String                                                           '==Accesのパス(存在している必用がある) 例) D:\TEST\Database1.accdb

Dim strSheet As String                                                             '==対象のシート名 例) お客様マスタ

Dim bolTopTitle As Boolean                                                         '==TRUE(先頭行をフィールド名として扱う) FALSE;先頭行はフィールド名ではない

Dim strNewAdd As String                                                            '=="NEW":新しいテーブルとして（既存データがあれば消される) "NEW"以外はテーブルにデータが既にあればデータ追加となる

'

'***TEST用データブック

    strGibNam = ThisWorkbook.Sheets(1).Range("DataPath")

    If strGibNam = "" Then

       MSGBOX "TEST用データブックを指定して下さい"

       Exit Sub

    End If

'

'***TEST用ACCESS DB

    strMdbPath = ThisWorkbook.Sheets(1).Range("DataPath2")

    If strMdbPath = "" Then

       MSGBOX "TEST用データベースを指定して下さい"

       Exit Sub

    End If

'

'***CALL

    strSheet = "M1お客様マスタ"                                                    '==対象のシート名 例) お客様マスタ

    bolTopTitle = True                                                             '==TRUE(先頭行をフィールド名として扱う) FALSE;先頭行はフィールド名ではない

    strNewAdd = "NEW"                                                              '=="NEW":新しいテーブルとして（既存データがあれば消される) "NEW"以外はテーブルにデータが既にあればデータ追加となる

    Call SP_7010_XLS2MDB(strGibNam, strMdbPath, strSheet, bolTopTitle, strNewAdd)

'

'***EXIT

    MSGBOX "インポートしました"

    Exit Sub

End Sub