1

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
4

1 に答える 1

0

Microsoft Office 12.0 Access Database Engine Object Library古い DAO ライブラリではなく、への参照が必要です。

于 2012-08-03T20:25:22.210 に答える