Question

免责声明：我不是程序员，但我必须运行此宏。谢谢：）

在具有64位Windows 10和Office 365的64位计算机上运行Excel工作簿中的以下宏会导致未注册类错误。多年来，这些代码在各种计算机和较旧版本的Windows / Office上一直未更改。与访问VBA有关的其他帖子说，它们引用“ Microsoft Office 16.0对象库”来运行旧的DAO代码，但没什么区别。

Sub Create_DB()
On Error GoTo Error_Create_DB
Dim DB As DAO.Database
Dim TblDef As DAO.TableDef
Dim RS As DAO.Recordset
Dim RowCounter As Integer
Dim MYFLD_Name As String
Dim MyField As DAO.Field
Dim MYFld_Type As Integer
Dim MYFld_Size As Long
Dim MYFld_Value As Variant
Dim Temp As Variant
Dim mypath As String
Dim MyCount As Integer


If Worksheets("DB").Range("L4").Value = True Then
    MsgBox "Invalid Configuration, unable to create UFC file." & vbCrLf & "Check variables on Printout tab.", vbOKOnly
    GoTo Create_DB_Exit
End If


mypath = ActiveWorkbook.Path & "\temp.ucf"
MyCount = Worksheets("DB").Range("$L$2").Value 'Row number of last variable
Temp = ""

Temp = Application.GetSaveAsFilename(Temp, filefilter:="config File (*.UCF), *.UCF", Title:="Save config")
If Temp = False Then GoTo Create_DB_Exit
If Dir(Temp) <> "" Then
    If MsgBox("File Exists, Overwrite?", vbOKCancel) = vbOK Then
        Kill Temp
    Else
    GoTo Create_DB_Exit
    End If
End If


If Temp <> False Then


Set DB = DAO.DBEngine.CreateDatabase(mypath, dbLangGeneral, dbVersion30)

Set TblDef = DB.CreateTableDef("TIE")
With TblDef
    For RowCounter = 2 To MyCount
        MYFLD_Name = Worksheets("DB").Cells(RowCounter, 1).Value
        MYFld_Type = Worksheets("DB").Cells(RowCounter, 2).Value
        MYFld_Size = Worksheets("DB").Cells(RowCounter, 3).Value
        .Fields.Append .CreateField(MYFLD_Name, MYFld_Type, MYFld_Size)

    Next RowCounter
End With

DB.TableDefs.Append TblDef

Set RS = DB.OpenRecordset("TIE")

RS.AddNew
For RowCounter = 2 To MyCount
    MYFLD_Name = Worksheets("DB").Cells(RowCounter, 1).Value
    MYFld_Value = Worksheets("DB").Cells(RowCounter, 5).Value

    RS.Fields(MYFLD_Name) = MYFld_Value
Next RowCounter
RS.Update


Set RS = Nothing
Set TblDef = Nothing
Set DB = Nothing
DBEngine.CompactDatabase mypath, Temp 'how to compact db
Kill mypath

End If  'temp <> false

Create_DB_Exit:
    Set RS = Nothing
    Set TblDef = Nothing
    Set DB = Nothing
    Exit Sub


Error_Create_DB:
    MsgBox Err.Description
    Resume Create_DB_Exit

End Sub

使用DAO创建文件时出现“未注册类”错误

0 个答案: