Откройте таблицу Excel как DAO RecordSet для добавления - PullRequest
Новая
       13

Откройте таблицу Excel как DAO RecordSet для добавления

0 голосов
/ 14 апреля 2020

Я пытаюсь обновить таблицу в файле Excel из DAO, как если бы это была таблица базы данных. Похоже, что-то, что должно быть возможно, но я не могу найти документацию об открытии Excel с DAO.

Я дошел до открытия файла и получения дескриптора набора записей, но я вижу ошибку 3027 "Не удается обновить База данных или объект только для чтения. " когда я пытаюсь добавить в набор записей. Одна из проблем заключается в том, что я могу видеть лист как таблицу, но не могу найти таблицу Excel на этом листе как объект. Возможно, я не знаю правильный синтаксис для открытия таблицы как набора записей.

Код, который я использую, задает dbOpenDynaset, как если бы вы сделали таблицу Access доступной для записи. Что я пытаюсь даже возможно?

Ошибка возникает на ".AddNew": 

Const dbOpenDynaset As Long = 2
Const dbAppendOnly As Long = 8
Const dbOptimistic As Long = 3

Public Sub OpenExcelAsDB(ByVal excelFile As String) 
    Dim fileExtension As String
    fileExtension = Right$(excelFile, Len(excelFile) - InStrRev(excelFile, "."))

    Dim connectionString As String
    Select Case fileExtension
    Case "xls"
        connectionString = "Excel 8.0;HDR=YES;IMEX=1"
    Case "xlsx"
        connectionString = "Excel 12.0 Xml;HDR=YES;IMEX=1"
    Case "xlsb"
        connectionString = "Excel 12.0;HDR=YES;IMEX=1"
    Case "xlsm"
        connectionString = "Excel 12.0 Macro;HDR=YES;IMEX=1"
    Case Else
        connectionString = "Excel 8.0;HDR=Yes;IMEX=1"
    End Select

    With CreateObject("DAO.DBEngine.120")
        With .OpenDatabase(excelFile, False, False, connectionString)
            With .OpenRecordset("LogSheet$", dbOpenDynaset, dbAppendOnly, dbOptimistic) 
                .AddNew
                With .Fields()
                    .Item("errorNumber").Value = errorNumber
                    .Item("errorDescription").Value = errorDescription
                    .Item("customNote").Value = customNote
                    .Item("errorDate").Value = Now()
                    .Item("Username").Value = UserLogon
                    .Item("Computer").Value = ComputerName
                End With

                .Update
                .Close
            End With

            .Close
        End With
    End With
End Sub

1 Ответ

0 голосов
/ 16 апреля 2020

Это кажется довольно старым технологическим стеком, на данный момент. Я думаю, что это было в начале 1990-х годов и, безусловно, все еще сохраняется, но поддержка, похоже, сокращается. Итак, с этим предупреждением, вы можете попробовать что-то вроде этого. 

Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
    Set db = OpenDatabase("C:\FolderName\DataBaseName.mdb") 
    ' open the database
    Set rs = db.OpenRecordset("TableName", dbOpenTable) 
    ' get all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0 
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("A" & r).Value
            .Fields("FieldName2") = Range("B" & r).Value
            .Fields("FieldNameN") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
End Sub

Лично я бы держался подальше от подобных вещей и сосредоточился бы на каком-то стеке облачных технологий.

...