Access (2007) データベースを Access (2010) データベースに変換するまでは、次の Excel VBA コードが正常に機能していました。Access (2010) のいくつかの新機能を使用してデータベースを改善しましたが、Excel マクロが実行されなくなりました。次のメッセージが表示されます。
実行時エラー 3343 未認識のデータベース形式
修正は簡単だと思いますが、私はプログラマーではないので、迷っています.... よろしくお願いします。
Sub Get_Hardware() 'Retrieves hardware weights from Access database
'********Note: If program fails to run, in the visual basic editor, under tools, references, you may
' need to have "Microsoft DAO 3.6 Object Library" downloaded**********
' ******* May also need to register DAO 3.6 if it does not apear in the selectable list by doing the following.
' 1. Open Window's start menu and select "Run"
' 2. Paste the following into the run windo and tell it to run it....
' regsvr32 "c:\program files\common files\microsoft shared\dao\dao360.dll"
Do While Not IsEmpty(ActiveCell.Offset(0, 0))
DAOCopyFromRecordSet "\\fil-ict-07\s0052491$\Engineering\Mass Properties Database (Access 2010)\Mass Properties Database (2010).accdb", "Hardware", "Part Number", ActiveCell
ActiveCell.Offset(1, 0).Select
Loop
End Sub
___________________________________________________________________________________________
Public Sub DAOCopyFromRecordSet(DBFullName As String, TableName As String, _
FieldName As String, TargetRange As Range)
Dim db As Database, UW, MC, Des, WQ As Recordset
Dim intColIndex As Integer
Dim MatCode As String
Set TargetRange = TargetRange.Cells(1, 3)
Set db = OpenDatabase(DBFullName)
'SQL Query
Set UW = db.OpenRecordset("SELECT Std_Parts.UnitWeight FROM Std_Parts WHERE (((Std_Parts.[Part Number]) = '" & _
ActiveCell.Offset(0, 0).Value & "'))", dbReadOnly)
Set MC = db.OpenRecordset("SELECT Std_Parts.Material_Code FROM Std_Parts WHERE (((Std_Parts.[Part Number]) = '" & _
ActiveCell.Offset(0, 0).Value & "'))", dbReadOnly)
Set Des = db.OpenRecordset("SELECT Std_Parts.Description FROM Std_Parts WHERE (((Std_Parts.[Part Number]) = '" & _
ActiveCell.Offset(0, 0).Value & "'))", dbReadOnly)
Set WQ = db.OpenRecordset("SELECT Std_Parts.Qual FROM Std_Parts WHERE (((Std_Parts.[Part Number]) = '" & _
ActiveCell.Offset(0, 0).Value & "'))", dbReadOnly)
' write recordset
TargetRange.CopyFromRecordset UW
Set TargetRange = TargetRange.Cells(1, 0)
TargetRange.CopyFromRecordset Des
Set TargetRange = TargetRange.Cells(1, 3)
TargetRange.CopyFromRecordset MC
Set TargetRange = TargetRange.Cells(1, 22)
TargetRange.CopyFromRecordset WQ
ActiveCell.Offset(0, 6).Select
ActiveCell.Formula = "=RC[-4]*RC[-1]"
GoOn:
ActiveCell.Offset(0, -6).Select
Set UW = Nothing
Set MC = Nothing
Set Des = Nothing
Set WQ = Nothing
db.Close
End Sub