excelvbaでCreateThreadの動作
Excel2007で、VBAを利用した簡単なデータエントリ、管理ソフトを作成しています。
ACCESSが無いため、データベースもExcelファイルを使用しています。
ADODBで、データベース用のExcelファイルを開くのですが、エントリ数が増えるに従い、openに時間がかかるようになってきました。そのため、プログレスバーで、VBAが動作していることをアピールすることとしました。
まず、非同期接続を試したのですが、connectionを数回OpenとCloseを繰り返すと、coinitializeでエラーが出てしまい、Excelが落ちる状況となってしまうためあきらめました。
次の手段として、CreateThreadでスレッドを作成して、connectionOpenのスレッドと、プログレスバーのコントロールを分離しようと作成してみましたが、CreateThreadで作成した方のプログラムがうまいこと動作してくれません。
ConnectionOpenをメイン、プログレスバーを別スレッドにしたもの、プログレスバーをメイン、ConnectionOpenを別スレッドにしたものを両方作成してみましたが、どちらも別スレッドにした方がうまく動きません。
debug.print "test"を別スレッドの1行目に入れたところ、イミディエイトに表示されるので、処理が渡っていないわけではないようです。
また、openをメインスレッドにした時にわかっているのは、メインスレッドのADOCon.Openの行が実行されたと同時に、別スレッドが止まってしまっているようです。
もしかして、CreateThreadは割り込みがかけられないような状況では別のスレッドは動作しないのでしょうか?また、CreateThreadで作成されたスレッドは、重たい処理は無理なのでしょうか?
テスト用のデータです。
'Busyというユーザーフォームに、PBerというプログレスバーを配置
'C:\Users\xx\Desktop\に、DBファイルを配置 XXは、ユーザー名
'mihon.xlsxは、約5MB
'変数等は、両タイプとも共通
Public bRun As Boolean
Public adoCON As New ADODB.Connection
Public Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Long, _
ByVal dwStackSize As Long, ByVal lpStartAddress As Long, _
ByRef lpParameter As Long, ByVal dwCreationFlags As Long, _
ByRef lpThreadID As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'connectionOpenをメイン、プログレスバーを別スレッド
Sub AdoOpen()
Dim ThreadId As Long
Dim hThread As Long
With Busy
.BusyMes.Caption = "DB接続処理中"
.PBar.Visible = True
.PBar.Value = 0
.PBar.Min = 0
.PBar.Max = 10
.Show vbModeless
End With
DoEvents
bRun = False
hThread = CreateThread(0&, 0&, AddressOf Counter, 0&, 0&, ThreadId)
Application.Wait [NOW()+"0:00:00.5"]
With adoCON
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Extended Properties") = "Excel 12.0"
.Open "C:\Users\xx\Desktop\mihon.xlsx"
End With
bRun = True
If hThread Then
CloseHandle hThread
hThread = 0
End If
With Busy
.BusyMes.Caption = ""
.PBar.Value = 0
.PBar.Visible = False
.Hide
End With
DoEvents
End Sub
Function Counter() ' As Boolean
Dim bCountup As Boolean
Do Until bRun
Select Case Busy.PBar.Value
Case 0
bCountup = True
Case 10
bCountup = False
End Select
If bCountup Then
Busy.PBar.Value = Busy.PBar.Value + 1
Else
Busy.PBar.Value = Busy.PBar.Value - 1
End If
Sleep 500
Loop
End Function
'プログレスバーをメイン、connectionOpenを別スレッド
Sub CounterStart()
Dim bCountup As Boolean
Dim ThreadId As Long
Dim hThread As Long 'スレッドハンドル
With Busy
.BusyMes.Caption = "DB接続処理中"
.PBar.Visible = True
.PBar.Value = 0
.PBar.Min = 0
.PBar.Max = 10
.Show vbModeless
End With
DoEvents
bRun = False
hThread = CreateThread(0&, 0&, AddressOf Counter2, 0&, 0&, ThreadId)
Do Until bRun
Select Case Busy.PBar.Value
Case 0
bCountup = True
Case 10
bCountup = False
End Select
If bCountup Then
Busy.PBar.Value = Busy.PBar.Value + 1
Else
Busy.PBar.Value = Busy.PBar.Value - 1
End If
Application.Wait [NOW()+"0:00:01.5"]
Loop
If hThread Then
CloseHandle hThread
hThread = 0
End If
With Busy
.BusyMes.Caption = ""
.PBar.Value = 0
.PBar.Visible = False
.Hide
End With
DoEvents
End Sub
Function Counter2()
With adoCON
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ObjDB.Value & "; Extended Properties=""Excel 12.0;"""
.Open "C:\Users\xx\Desktop\mihon.xlsx"
End With
bRun = True
End Function