VB.Net:DAO对象不会创建DBEngine

时间:2010-10-08 16:39:21

标签: vb.net windows-7 dao

我正在使用动态创建的Access数据库作为正在输入的文件的临时存储。我知道一切正常,就像在我的开发机器上我可以运行此代码。但是在另一个系统(Win 7)上它没有用。我被拦在这条线上......

DAOEngine = New DAO.DBEngine

当它到达时,它只会抛出错误......

Creating an instance of the COM component with CLSID {00000010-0000-0010-8000-00AA006D2EA4} from the IClassFactory failed due to the following error: 80040112.

我已经搜索了错误,我无法理解它告诉我的其他信息,然后我使用旧的方式创建数据库。现在,我希望快速修复,而不是重写我的存储工作方式。

同样,我知道我的代码是正确的,因为我的开发机器编译并运行此代码就好了。我将发布整个方法以防万一我还缺少其他东西。

    Private Sub ProcessFile(ByVal Exportname As String, ByVal ExportFile As String, ByVal ImportFile As String)
    ' Aperture variables
    Dim Table As Object 'OETable
    Dim Fields As Object 'OEFields

    ' DAO database variables
    Dim DAOEngine As DAO.DBEngine
    Dim rst As DAO.Recordset
    Dim ws As DAO.Workspace
    Dim db As DAO.Database
    Dim tbl As DAO.TableDef
    Dim fld As DAO.Field

    ' Integer vars
    Dim fieldcount As Integer
    Dim I As Integer
    Dim j As Integer
    ' Boolean Variables
    Dim CalcTotals As Boolean = False
    ' String Array Variables
    Dim headers() As String = Nothing
    ' String Variables
    Dim lvl_lookup As String
    Dim outputlist As String
    Dim throwaway As String = ""
    Dim totalstring As String
    ' Array vars
    Dim totals() As Object

    ' Use an access database to add the serial numbers
    'ws = DAODBEngine_definst.Workspaces(0)
    DAOEngine = New DAO.DBEngine
    ws = DAOEngine.Workspaces(0)
    If File.Exists(alAperture.prjPath & "\temp.mdb") Then
        File.Delete(alAperture.prjPath & "\temp.mdb")
    End If
    db = ws.CreateDatabase(alAperture.prjPath & "\temp.mdb", DAO.LanguageConstants.dbLangGeneral)
    tbl = db.CreateTableDef("legend")

    If alAperture.tbls.Item(Exportname & " Table") Is Nothing Then
        Table = alAperture.tbls.Item("Legend Text Table")
    Else
        Table = alAperture.tbls.Item(Exportname & " Table")
    End If

    Fields = Table.Fields
    fieldcount = Fields.Count
    ' Create the fields
    For I = 0 To fieldcount - 1
        If Fields.Item(I).DataType = 2 Then
            ' We have a numeric field
            fld = tbl.CreateField(Fields.Item(I).Name, 6)
            CalcTotals = True
        Else
            fld = tbl.CreateField(Fields.Item(I).Name, 10, 255)
            fld.AllowZeroLength = True
        End If
        tbl.Fields.Append(fld)
    Next
    ' Create the table
    db.TableDefs.Append(tbl)

    ' Open the table as a recordset
    rst = db.OpenRecordset("legend", DAO.RecordsetTypeEnum.dbOpenTable)
    ' Open the exportfile for read
    Dim streamIn As StreamReader = New StreamReader(ExportFile)
    ReDim totals(fieldcount - 1)

    I = 0
    lvl_lookup = ""

    Do
        ' Grab next record and redim to dimension of table, minus the series column
        Dim nextRecord() As String = Split(streamIn.ReadLine, """,""")
        ReDim Preserve nextRecord(fieldcount - 1)
        If I = 0 Then
            headers = nextRecord
            I = 1
        Else
            ' *** HEADER RECORD
            If lvl_lookup = "" Then
                lvl_lookup = nextRecord(0)
                ' Add the header record
                rst.AddNew()
                rst.Fields(0).Value = lvl_lookup
                rst.Fields(1).Value = 0
                For j = 2 To fieldcount - 1
                    If rst.Fields(j).Type = 10 Then
                        rst.Fields(j).Value = Replace(headers(j - 1), """", "")
                    Else
                        rst.Fields(j).Value = 0
                    End If
                Next
                rst.Update()
            End If
            ' *** RECORDS
            If nextRecord(0) = lvl_lookup Then
                ' addrecords
                addrecord(totals, nextRecord, rst, fieldcount, I)
            Else
                ' add total row
                ' padlines
                If CalcTotals Then
                    rst.AddNew()
                    rst.Fields(0).Value = lvl_lookup
                    rst.Fields(1).Value = I
                    totalstring = "Total:"
                    For j = 2 To fieldcount - 2
                        If rst.Fields(j).Type = 6 Then
                            If IsNothing(totals(j)) Then
                                rst.Fields(j).Value = 0
                            Else
                                rst.Fields(j).Value = totals(j)
                            End If
                        Else
                            rst.Fields(j).Value = totalstring
                            totalstring = ""
                        End If
                    Next
                    rst.Fields(9).Value = 0
                    rst.Update()
                    I = I + 1
                End If
                'padlines
                While I <= 80
                    rst.AddNew()
                    rst.Fields(0).Value = lvl_lookup
                    rst.Fields(1).Value = I
                    rst.Update()
                    I = I + 1
                End While
                I = 1
                lvl_lookup = nextRecord(0)
                ReDim totals(fieldcount - 2)
                ' add record
                addrecord(totals, nextRecord, rst, fieldcount, I)
            End If
            If streamIn.EndOfStream Then
                ' add total row
                ' padlines
                If CalcTotals Then
                    rst.AddNew()
                    rst.Fields(0).Value = lvl_lookup
                    rst.Fields(1).Value = I
                    totalstring = "Total:"
                    For j = 2 To fieldcount - 2
                        If rst.Fields(j).Type = 6 Then
                            If IsNothing(totals(j)) Then
                                rst.Fields(j).Value = 0
                            Else
                                rst.Fields(j).Value = totals(j)
                            End If
                        Else
                            rst.Fields(j).Value = totalstring
                            totalstring = ""
                        End If
                    Next
                    rst.Fields(9).Value = 0
                    rst.Update()
                    I = I + 1
                End If
                'padlines
                While I <= 80
                    rst.AddNew()
                    rst.Fields(0).Value = lvl_lookup
                    rst.Fields(1).Value = I
                    rst.Update()
                    I = I + 1
                End While
            End If
        End If
    Loop Until streamIn.EndOfStream
    streamIn.Close()
    ' ok lets write the import file

    Dim streamOut As StreamWriter = New StreamWriter(ImportFile)
    rst.MoveFirst()
    Do Until rst.EOF
        outputlist = Chr(34) & rst.Fields(0).Value & Chr(34) & "," & Chr(34) & VB6.Format(rst.Fields(1).Value, "00") & Chr(34)
        For j = 2 To fieldcount - 1
            outputlist = outputlist & "," & Chr(34) & rst.Fields(j).Value & Chr(34)
        Next
        streamOut.WriteLine(outputlist)
        rst.MoveNext()
    Loop
    streamOut.Close()
    rst.Close()
    db.Close()
    ws.Close()

    rst = Nothing
    db = Nothing
    ws = Nothing
    fld = Nothing
    tbl = Nothing
    Table = Nothing
    Fields = Nothing
End Sub

1 个答案:

答案 0 :(得分:2)

您使用的是Microsoft DAO 3.6吗?使用“Microsoft DAO 2.5 / 3.51兼容性库”已经很老了。 DAO 3.5是Access 97附带的版本。

稍后我应该在错误消息中搜索GUID。是的,该GUID适用于DAO 3.5,它非常陈旧,附带Access 97和Visual Basic 6.使用Weindows 2000及更新操作系统附带的DAO 3.6 / Jet 4.0。

PRB: CLSID {00000010-0000-0010-8000-00AA006D2EA4} Not Found When You Run an Application“{00000010-0000-0010-8000-00AA006D2EA4} CLSID与DAO350.dll相关联。”