ボンジュール・マドモアゼル

本サイトの情報は自己責任にてご利用下さい。

[Microsoft Access] ADOX Table を Append し Connection.Close で「Microsoft Access for Windows は動作を停止しました」のエラーが発生

 
下記の現象は Access 2000 で確認したもの。

ADOX.Column オブジェクトの ParentCatalog をサブプロシージャのなかで設定して、
それより上位のプロシージャで Connection をクローズするとエラーが発生する。

この現象は以下のサンプルコードによって確認できる。
以下のコードにおいて testNonError は testError で呼び出している createTable の処理を
展開して実行しているだけなので testNonError と testError の処理内容は、ほとんど同じである。
両プロシージャを実行すると testNonError は正常終了するが testError の方は
createTable の呼出し後、接続をクローズするところでエラーが発生する。

このエラーは、サブプロシージャの clm.ParentCatalog = cat が原因となっているようで、(この行がないとエラーは発生しない)
対処として cat.ActiveConnection = Nothing を処理しておくと、エラーは発生しなくなる。
Option Compare Database

Option Explicit

Sub testNonError()

dropTable "TEST_TABLE"

Dim cnn As ADODB.Connection
Set cnn = CurrentProject.Connection

Dim cat As ADOX.Catalog
Set cat = CreateObject("ADOX.Catalog")
cat.ActiveConnection = cnn

Dim tbl As ADOX.Table
Set tbl = CreateObject("ADOX.Table")
tbl.Name = "TEST_TABLE"

tbl.Columns.Append "TEST_FIELD", adVarWChar, 10

Dim clm As ADOX.Column
Set clm = tbl.Columns("TEST_FIELD")

clm.ParentCatalog = cat

cat.Tables.Append tbl

'Error does not occur.
cnn.Close

End Sub

Sub testError()

dropTable "TEST_TABLE"

Dim cnn As ADODB.Connection
Set cnn = CurrentProject.Connection

createTable cnn

'error occurs. Microsoft Access has stopped working
cnn.Close

End Sub

Sub createTable(cnn As ADODB.Connection)

Dim cat As ADOX.Catalog
Set cat = CreateObject("ADOX.Catalog")
cat.ActiveConnection = cnn

Dim tbl As ADOX.Table
Set tbl = CreateObject("ADOX.Table")
tbl.Name = "TEST_TABLE"

tbl.Columns.Append "TEST_FIELD", adVarWChar, 10

Dim clm As ADOX.Column
Set clm = tbl.Columns("TEST_FIELD")

'error is caused by this line.
clm.ParentCatalog = cat

cat.Tables.Append tbl

'error is fixed by this line.
'cat.ActiveConnection = Nothing
End Sub

Sub dropTable(TableName As String)
On Error Resume Next
DoCmd.DeleteObject acTable, TableName
On Error GoTo 0
End Sub

[Microsoft Access] DAO TableDefs.Refresh, QueryDefs.Refresh を実行しても最新状態が反映されない。

 
Jetのキャッシュの問題かもしれない。

Jet Engineのキャッシュとその制御
http://www.canalian.com/workshop/access/JetCache.html


キャッシュ強制リロード
DAOの場合
DBEngine.Idle dbRefreshCache
ADOの場合
Public Sub RefrechConnectionCache()


Dim Conn As ADODB.Connection
Set Conn = CurrentProject.Connection

Dim JetEngine As Object
Set JetEngine = CreateObject("JRO.JetEngine")
JetEngine.RefreshCache Conn

End Sub

[Microsoft Access] DAO, ADO ファイルの共有ロック数が制限を超えています (Error 3052)。回避方法

 
3052 共有ロック数の制限オーバーは、まめにコミットすることで防げるが、
このやり方は、単一のSQLコマンドでエラーが出るような場合には使えない。
この場合、ひとつ考えられる対処は、データベース(または接続)を排他モードで開いておくことである。以下は、そのサンプルコード。
Public Sub AlterTable()


Dim cnn As ADODB.Connection
Set cnn = New ADODB.Connection

Dim cnnStr As String
cnnStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=D:Test.mdb;"

Dim Sql As String
Sql = "ALTER TABLE CUSTOMER ALTER COLUMN CUSTOMER_ID TEXT(20);"

With cnn
.ConnectionString = cnnStr
.Mode = adModeShareExclusive
.Open
.Execute Sql, , adCmdText + adExecuteNoRecords
.Close
End With

End Sub


参考)
http://support.microsoft.com/kb/881843/ja
データベースを排他モードで開く方法
文書番号: 881843

[Microsoft Access] DAO.Database DAOデータベースがOpen状態かどうかを判定する方法

 
DAO.Database には オープンしてるかどうかを判定できるプロパティ、メソッドが見当たらない。
検索しても有効な手立てが見つからない。

自分が思い付いたのは、以下のような判定方法。
Option Explicit


Public Sub TestDaoDbOpenStatus()

Dim dbs As DAO.Database
Set dbs = CurrentDb()

Debug.Print DatabaseIsOpened(dbs)

dbs.Close

Debug.Print DatabaseIsOpened(dbs)

End Sub

Public Function DatabaseIsOpened(it As DAO.Database) As Boolean
If Not it Is Nothing Then
Dim ws As DAO.Workspace
For Each ws In DBEngine.Workspaces
Dim Db As DAO.Database
For Each Db In ws.Databases
If Db Is it Then
DatabaseIsOpened = True
Exit Function
End If
Next
Next
End If
DatabaseIsOpened = False
End Function
TestDaoDbOpenStatus の出力結果
True

False
参考)
Workspace.Databases Property (DAO)
Returns a Databases collection that represents the open databases in the specified Workspace. Read-only.
http://msdn.microsoft.com/en-us/library/ff834485.aspx

[VBScript] VBScript Windows ファイルパス比較

 
Windowsのファイルパスには、次のような仕様がある。
次のパス名はすべて同じファイルを示すものとして解釈される:
  1. d:\InetPub\wwwroot\secret\data.txt
     基本形
  2. d:\inetpub\WWWROOT\SECRET\DATA.TXT
     大文字小文字は同一視される
  3. d:/InetPub/wwwroot/secret/data.txt
     ディレクトリの区切りに「/」も使える
  4. d:\\InetPub\\\wwwroot\\\\secret\\\\\data.txt
     ディレクトリの区切り文字は幾つか重複しても構わない
  5. d:////InetPub///wwwroot//secret/data.txt
     「/」も重複できる
  6. d:\InetPub\.\wwwroot\.\.\secret\.\.\.\data.txt
     「カレントディレクトリ」を表す . を差し挟むことができる
  7. d:\fake\fake\..\..\InetPub\wwwroot\secret\data.txt
     実在しないディレクトリもあとで「..」で遡れば指定可能

http://www.ipa.go.jp/security/awareness/vendor/programmingv1/b08_01.html


以下は、上記の仕様に則ってファイルパスの比較を行うVBScriptのサンプルコード。少し修正すればVBAでも使えるはず。
'FilePathComp.vbs

Option Explicit

Call Test("C:WindoWSSystEm32", "C://///Windows////System32")
Call Test("C:WindowsWeb..SystEm32", "C:///Windows.SysTEM32")

Function FilePathsAreSame(FilePath1, FilePath2)
FilePathsAreSame = (StrComp(CanonicalizeFilePath(FilePath1), _
CanonicalizeFilePath(FilePath2), _
vbBinaryCompare) = 0)
End Function


Private fs
Function CanonicalizeFilePath(FilePath)
If IsEmpty(fs) Then
Set fs = CreateObject("Scripting.FileSystemObject")
End If
CanonicalizeFilePath = LCase(fs.GetAbsolutePathName(FilePath))
End Function


Sub Test(FilePath1, FilePath2)
Dim Paths(1)
Paths(0) = FilePath1
Paths(1) = FilePath2

WScript.Echo "FilePathsAreSame(""" & Paths(0) & _
""", """ & Paths(1) & """) ==> " & _
FilePathsAreSame(Paths(0), Paths(1))
Dim i
for i = 0 to 1
WScript.Echo "CanonicalizeFilePath(""" & Paths(i) & """)" & _
vbTab & "==> " & CanonicalizeFilePath(Paths(i))
Next
WScript.Echo
End Sub
出力結果
C:\>cscript FilePathComp.vbs

Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation 1996-2001. All rights reserved.

FilePathsAreSame("C:\\\WindoWS\\\\\SystEm32", "C://///Windows////System32") ==> True
CanonicalizeFilePath("C:\\\WindoWS\\\\\SystEm32") ==> c:\windows\system32
CanonicalizeFilePath("C://///Windows////System32") ==> c:\windows\system32

FilePathsAreSame("C:\Windows\Web\..\SystEm32", "C:///Windows\\.\SysTEM32") ==> True
CanonicalizeFilePath("C:\Windows\Web\..\SystEm32") ==> c:\windows\system32
CanonicalizeFilePath("C:///Windows\\.\SysTEM32") ==> c:\windows\system32
  1. 2012/03/20(火) 09:28:04|
  2. VBScript|
  3. トラックバック(-)|
  4. コメント:0
次のページ