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 回答