● AccessVBA ～ ExcelシートをSQLで部分インポートする方法２つ。既存テーブルへと、新規テーブル作成しながら。

投稿日 : 2024-07-07 最終更新日時 : 2024-07-07 投稿者 : vfaupe7 カテゴリー : 075010＿Access2000Tips

● AccessVBA ～ ExcelシートをSQLで部分インポートする方法２つ。既存テーブルへと、新規テーブル作成しながら。

　　
※まだ書きかけです。すみません。
※間違ってたらすみません。
※メモ書きなので、自分でも意味不明な箇所も多いです。ごめんなさい。
　　
　　

★ はじめに

２つあって、
１つめは、既存のテーブルにSQLで絞り込んだレコードを吸い込むもので、
２つめは、既存のテーブルをいったん消して、同名の新規テーブルを作り、
その中に、SQLで絞り込んだレコードを吸い込みます。

一応、両方とも10万件の40列、の内容から数行・数列に絞って処理しました。
（PassMarkのCPUスコアが6000くらいのノートPCでやりました）

6秒くらいかかりました。
20万件だと10秒かからないくらいでした。

　　
★既存のテーブルにSQLで絞り込んだレコードを吸い込むもの

'
'


GPTへの質問内容
AccessにExcelシートを、SQLを使って部分インポートするVBAコードを教えて


Option Compare Database
Option Explicit

Sub ImportExcelToAccess()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strExcelPath As String
    Dim strSQL As String

    Dim s_WsName As String
    Dim s_ConnectStr As String
    
    ' Excelファイルのパス
'    strExcelPath = "d:\1\10r10c.xlsx"
    strExcelPath = "d:\1\10man40c.xlsx"

    '吸い込みたいExcelシート名
    s_WsName = "SheetA"
    
    ' Accessデータベースの参照を取得
    Set db = CurrentDb


    Let s_ConnectStr = "[Excel 12.0 Xml;HDR=YES;IMEX=2;ACCDB=YES;DATABASE="
    
    ' ExcelシートからデータをインポートするSQLクエリを作成
    ' 「ExcelData」という既存テーブル「f01」、「f02」という列に
    '  指定したExcelシートの「f01」、「f02」のレコードを吸い込み。
    '  このテストでは「WHERE f01 = 3」のみを。
    strSQL = "INSERT INTO ExcelData (f01, f02) " & _
             "SELECT f01, f01 " & _
             "FROM " & s_ConnectStr & strExcelPath & "].[" & s_WsName & "$] " & _
             "WHERE f01 = 3;"
    
    ' SQLクエリを実行
    db.Execute strSQL, dbFailOnError
    
    ' クリーンアップ
    Set rs = Nothing
    Set db = Nothing
    
    Debug.Print "Data imported successfully!"
    
End Sub


'
'

GPTへの質問内容

AccessにExcelシートを、SQLを使って部分インポートするVBAコードを教えて

Option Compare Database

Option Explicit

Sub ImportExcelToAccess()

Dim db As DAO.Database

Dim rs As DAO.Recordset

Dim strExcelPath As String

Dim strSQL As String

Dim s_WsName As String

Dim s_ConnectStr As String

' Excelファイルのパス

' strExcelPath = "d:\1\10r10c.xlsx"

strExcelPath = "d:\1\10man40c.xlsx"

'吸い込みたいExcelシート名

s_WsName = "SheetA"

' Accessデータベースの参照を取得

Set db = CurrentDb

Let s_ConnectStr = "[Excel 12.0 Xml;HDR=YES;IMEX=2;ACCDB=YES;DATABASE="

' ExcelシートからデータをインポートするSQLクエリを作成

' 「ExcelData」という既存テーブル「f01」、「f02」という列に

' 指定したExcelシートの「f01」、「f02」のレコードを吸い込み。

' このテストでは「WHERE f01 = 3」のみを。

strSQL = "INSERT INTO ExcelData (f01, f02) " & _

"SELECT f01, f01 " & _

"FROM " & s_ConnectStr & strExcelPath & "].[" & s_WsName & "$] " & _

"WHERE f01 = 3;"

' SQLクエリを実行

db.Execute strSQL, dbFailOnError

' クリーンアップ

Set rs = Nothing

Set db = Nothing

Debug.Print "Data imported successfully!"

End Sub

　　
★既存のテーブルをいったん消して、同名の新規テーブルを自動で作り、その中に、SQLで絞り込んだレコードを吸い込み

'
'


GPTへの質問内容
AccessにExcelシートを、SQLを使って部分インポートし、かつ、それでテーブル作成までをするVBAコードを教えて


Option Compare Database
Option Explicit


Sub ImportExcelToAccessAndCreateTable()
    Dim db As DAO.Database
    Dim strExcelPath As String
    Dim strSQL As String
    Dim newTableName As String
    
    Dim s_WsName As String
    Dim s_ConnectStr As String
    
    ' Excelファイルのパス
'    strExcelPath = "d:\1\10r10c.xlsx"
    strExcelPath = "d:\1\10man40c.xlsx"
    
    '吸い込みたいExcelシート名
    s_WsName = "SheetA"

    ' 新しいテーブルの名前
    newTableName = "Exceldata01"
    
    ' Accessデータベースの参照を取得
    Set db = CurrentDb
    
    ' 既存のテーブルを削除（既に存在する場合）
    On Error Resume Next
    db.Execute "DROP TABLE " & newTableName, dbFailOnError
   
    On Error GoTo 0
    
    
    Let s_ConnectStr = "[Excel 12.0 Xml;HDR=YES;IMEX=2;ACCDB=YES;DATABASE="
    
    ' 「Excelシートから吸い込んだレコードで新規テーブルを作成する」
    '  というSQLクエリを作成。
    '  指定したテーブル名とフィールド名で作った新規テーブルに、
    '  ExcelシートのSQLで絞り込んだ部分を吸い込みます。
    '  このテストでは、「Exceldata01」という新規テーブルを作り、
    '  その中に、「f01」、「f02」、「f03」、「f04」、というフィールドも作り、
    '  指定したExcelシートの
    ' 「f01」、「f02」、「f03」、「f04」、のレコードを吸い込み。
    ' 「WHERE f01 BETWEEN 3 AND 8」の部分のみを。
    
    strSQL = "SELECT f01, f02, f03 , f04 " & _
             "INTO " & newTableName & " " & _
             "FROM " & s_ConnectStr & strExcelPath & "].[" & s_WsName & "$] " & _
             "WHERE f01 BETWEEN 3 AND 8;"

    
    ' SQLクエリを実行して新しいテーブルを作成
    db.Execute strSQL, dbFailOnError
'    db.Execute strSQL
    
    ' クリーンアップ
    Set db = Nothing
    
    Application.RefreshDatabaseWindow
    'データベースウィンドウに反映表示。
    
    Debug.Print "Table created and data imported successfully!"
    
End Sub



'
'

GPTへの質問内容

AccessにExcelシートを、SQLを使って部分インポートし、かつ、それでテーブル作成までをするVBAコードを教えて

Option Compare Database

Option Explicit

Sub ImportExcelToAccessAndCreateTable()

Dim db As DAO.Database

Dim strExcelPath As String

Dim strSQL As String

Dim newTableName As String

Dim s_WsName As String

Dim s_ConnectStr As String

' Excelファイルのパス

' strExcelPath = "d:\1\10r10c.xlsx"

strExcelPath = "d:\1\10man40c.xlsx"

'吸い込みたいExcelシート名

s_WsName = "SheetA"

' 新しいテーブルの名前

newTableName = "Exceldata01"

' Accessデータベースの参照を取得

Set db = CurrentDb

' 既存のテーブルを削除（既に存在する場合）

On Error Resume Next

db.Execute "DROP TABLE " & newTableName, dbFailOnError

On Error GoTo 0

Let s_ConnectStr = "[Excel 12.0 Xml;HDR=YES;IMEX=2;ACCDB=YES;DATABASE="

' 「Excelシートから吸い込んだレコードで新規テーブルを作成する」

' というSQLクエリを作成。

' 指定したテーブル名とフィールド名で作った新規テーブルに、

' ExcelシートのSQLで絞り込んだ部分を吸い込みます。

' このテストでは、「Exceldata01」という新規テーブルを作り、

' その中に、「f01」、「f02」、「f03」、「f04」、というフィールドも作り、

' 指定したExcelシートの

' 「f01」、「f02」、「f03」、「f04」、のレコードを吸い込み。

' 「WHERE f01 BETWEEN 3 AND 8」の部分のみを。

strSQL = "SELECT f01, f02, f03 , f04 " & _

"INTO " & newTableName & " " & _

"FROM " & s_ConnectStr & strExcelPath & "].[" & s_WsName & "$] " & _

"WHERE f01 BETWEEN 3 AND 8;"

' SQLクエリを実行して新しいテーブルを作成

db.Execute strSQL, dbFailOnError

' db.Execute strSQL

' クリーンアップ

Set db = Nothing

Application.RefreshDatabaseWindow

'データベースウィンドウに反映表示。

Debug.Print "Table created and data imported successfully!"

End Sub

投稿タグ: Ac2000-Win32API, AccessVBA, Accessの独学, ExcelVBA, Excelの独学, パソコンでの自動化, マクロ, 独学, 自動化

MENU

関連記事

最近の投稿

カテゴリー

MENU

● AccessVBA ～ ExcelシートをSQLで部分インポートする方法２つ。既存テーブルへと、新規テーブル作成しながら。

関連記事

最近の投稿

カテゴリー

タグ