『ADODB.Connection.Open が遅い』（tkit）
ADODBで、Excelのテーブルに対しSQLでデータを取得しているのですが、 Openで12秒程掛かります。
確認した条件は、以下パターンです。 Win11 Excel2019 Win10 Excel2019及び2016
2025年4月のWindows Updateあたりから遅くなったように 思います。
同様の方は、いらっしゃいますか？ また、他のExcelバージョンで検証いただけましたら助かります。
当方、以下サンプルコードで再現しています。
Sub sample()
'サンプル作成
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets.Add()
ws.Name = "tempSheet"
Dim temp(10, 2)
temp(0, 0) = "col1": temp(0, 1) = "col2": temp(0, 2) = "col3"
Dim i&
For i = 1 To 10
temp(i, 0) = i
temp(i, 1) = i * 2
temp(i, 2) = i * 3
Next
Dim rng As Range
Set rng = ws.Range("A1:C11")
rng.Value = temp
'接続&取得
Dim t#: t = Timer
Dim conn As ADODB.Connection
Set conn = New ADODB.Connection
With conn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source = " & ThisWorkbook.FullName & ";"
.Properties("Extended Properties") = "Excel 12.0 Xml;HDR=YES"
Debug.Print "[Before]"; Timer - t
.Open
Debug.Print "[Open]"; Timer - t
End With
Debug.Print Timer - t
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "SELECT * FROM [tempSheet$A1:C11]", conn, adOpenStatic
Debug.Print "[RecordSet]"; Timer - t
'後始末
If Not rs Is Nothing Then
If rs.State <> 0 Then rs.Close
Set rs = Nothing
End If
If Not conn Is Nothing Then
If conn.State <> 0 Then conn.Close
Set conn = Nothing
End If
ws.Delete
End Sub
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
▼Excel2016(32bit)/win10(x64)での結果
(初回) [Before] 0.96875 [Open] 1.65625 1.65625 [RecordSet] 1.84375
(2回目) [Before] 0 [Open] 0.015625 0.015625 [RecordSet] 0.015625
大丈夫そうですね。
▼Excel2010/win7(x86)での結果
[Before] 0.021484375 [Open] 0.03125 0.03125 [RecordSet] 0.041015625
（白茶） 2025/04/18(金) 09:25:16
検証ありがとうございます。
一応、セキュリティソフトはOFFにして検証はしているのですが、 同じネットワーク内のPCは全て同症状なんですよね・・・
Win11、Win10は64bitで、Excelは2019，2016で32bitです。
（tkit） 2025/04/18(金) 09:37:43
Win10(64bit)、Excel2010(32bit)の環境で検証したら、 白茶さんの検証時間と同等でした。
もうちょっと試行錯誤してみます。 （tkit） 2025/04/18(金) 09:47:42
[Before] 0.078125
[Open] 12.1953125
12.1953125 [RecordSet] 12.2265625 （隠居Z） 2025/04/18(金) 09:59:14
Excel2021 32 ビット (バージョン 2503 ビルド 16.0.18623.20178) 同様にOpenで12秒程掛かります。
[Before] 0 [Open] 12.11328125 12.11328125 [RecordSet] 12.12890625
（まる2021） 2025/04/18(金) 10:26:51
ブックを開かずに別ブックから実行すると遅延はなくなりました。
Sub sample()
Const wb$ = "C:\Users\xxxx\Desktop\Book100.xlsm" 'データベースのある対象ブック
'接続&取得
Dim t#: t = Timer
Dim conn As ADODB.Connection
Set conn = New ADODB.Connection
With conn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source = " & wb & ";"
.Properties("Extended Properties") = "Excel 12.0;HDR=YES"
Debug.Print "[Before]"; Timer - t
.Open
Debug.Print "[Open]"; Timer - t
End With
Debug.Print Timer - t
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open "SELECT * FROM [tempSheet$A1:C11]", conn, adOpenStatic
Debug.Print "[RecordSet]"; Timer - t
Do Until rs.EOF
Debug.Print rs.Fields("col1").Value, rs.Fields("col2").Value, rs.Fields("col3").Value
rs.MoveNext
Loop
'後始末
If Not rs Is Nothing Then
If rs.State <> 0 Then rs.Close
Set rs = Nothing
End If
If Not conn Is Nothing Then
If conn.State <> 0 Then conn.Close
Set conn = Nothing
End If
End Sub
＜出力＞ [Before] 0.015625 [Open] 0.046875 0.046875 [RecordSet] 0.0625 1 2 3 2 4 6 3 6 9 4 8 12 5 10 15 6 12 18 7 14 21 8 16 24 9 18 27 10 20 30 （まる2021） 2025/04/18(金) 10:44:34
隠居Zさん、まる2021さん 検証ありがとうございます。 まる2021さんの別ブックでの遅延検証ありがとうございます。
以前も2020年頃にUpdateで不具合があったみたいなので、 自身だけなのか、そうではないのか、いろいろ探した結果、 何もヒットせず、質問した経緯となります。
同じ症状で嬉しいやら、でも悲しいやら、です。
別ブックから案でちょっと試してみます。
（tkit） 2025/04/18(金) 11:05:32
既に運用済みのブックに関しては、手直しせず、 様子見としました。
この事象で悩んでいる方の一助になれば幸いです。 （tkit） 2025/04/18(金) 15:11:42
これが影響していないでしょうか。
当方でも今まで正常だったSQLでの集計に遅延が発生するようになりましたが、Excelを以前のバージョンに戻したら改善されました。
（知らんけど） 2025/04/19(土) 09:31:14
知らんけど さん、情報ありがとうございます。
こちらも、Excelを以前のバージョンに戻したら改善されました。 Microsoftの修正待ちですね。
改めて、本事象で検証いただいた方々にお礼申し上げます。 （tkit） 2025/04/21(月) 08:43:36
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.