MS Access несколько обновлений таблицы из плоского Excel - PullRequest
Новая
       56

MS Access несколько обновлений таблицы из плоского Excel

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

Я пытаюсь сделать относительно общую задачу, я думаю. У меня есть плоский файл Excel, из которого я создал нормализованную базу данных Access. Теперь я хочу взять новые файлы Excel с тем же форматом и заполнить различные таблицы основных данных и таблицу транзакций. Структура похожа на это: файл Excel имеет столбцы для клиента, продукта и количества. В базе данных Access есть таблицы основных данных для клиента (столбцы ID, Customer_Name и Address) и продукта (столбцы ID, Product_Name и Color). Я хочу найти в новом файле Excel новых клиентов и новые продукты, а затем добавить их в соответствующие таблицы основных данных и автоматически назначить им новый инкрементный идентификационный номер. Затем я хочу создать записи в таблице «Заказы», ​​которые соответствуют строкам в файле Excel, но используют автоматически назначенные идентификаторы. Как может быть очевидно, весь смысл здесь в том, чтобы поддерживать нормализованную структуру при автоматизации задачи построения базы данных посредством импорта листов Excel, созданных в других местах. Я сумасшедший или это обычное дело? Пожалуйста помоги! Ты лучший, если сможешь!

1 Ответ

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

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

Sub sGetCustomerData(strXLFile As String)
    On Error GoTo E_Handle
    Dim db As DAO.Database
    Dim rsCustomer As DAO.Recordset
    Dim rsAdd As DAO.Recordset
    Dim strSQL As String
    DoCmd.DeleteObject acTable, "tblTemp"
    DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel12Xml, "tblTemp", strXLFile, True
    Set db = DBEngine(0)(0)
    strSQL = "SELECT T.Customer " _
        & " FROM tblTemp AS T LEFT JOIN tblCustomer AS C ON T.Customer=C.Customer_Name " _
        & " WHERE C.Customer_Name IS NULL;"
    Set rsCustomer = db.OpenRecordset(strSQL)
    If Not (rsCustomer.BOF And rsCustomer.EOF) Then
        Set rsAdd = db.OpenRecordset("SELECT * FROM tblCustomer WHERE 1=2;")
        Do
            With rsAdd
                .AddNew
                !Customer_Name = rsCustomer!Customer
                .Update
            End With
            rsCustomer.MoveNext
        Loop Until rsCustomer.EOF
    End If
sExit:
    On Error Resume Next
    rsAdd.Close
    rsCustomer.Close
    Set rsAdd = Nothing
    Set rsCustomer = Nothing
    Set db = Nothing
    DoCmd.DeleteObject acTable, "tblTemp"
    Exit Sub
E_Handle:
    Select Case Err.Number
        Case 7874   '   temp table not found to delete
            Resume Next
        Case 7889   '   file does not exist
        Case Else
        MsgBox Err.Description & vbCrLf & vbCrLf & "sGetCustomerData", vbOKOnly + vbCritical, "Error: " & Err.Number
    End Select
    Resume sExit
End Sub

Вы можете столкнуться с проблемами с данными в файле Excel, дублирующимися с немного другим написанием - "Мистер Дж. Смит" / "Мистер Дж. Смит "/" Мистер Джон Смит ", например.

С уважением,

...