Обновление MS - Доступ к полям через ячейки MS-Excel - PullRequest
3 голосов
/ 04 мая 2010

Учтите, что у меня есть книга Excel и таблица Access, необязательно имеющая сходную структуру (т. Е. Они могут не иметь одинакового количества столбцов).

Когда я открываю книгу, строки на листе Excel заполняются строками таблицы Access (копируются из таблицы Access в определенный диапазон ячеек листа Excel, указанный с помощью макросов).

Затем я изменяю определенные ячейки на листе Excel.

У меня также есть кнопка «Сохранить» на листе Excel. При нажатии выполняется макрос.

Мой вопрос: как я могу обновить таблицу Access, чтобы отразить изменения в листе Excel при нажатии кнопки «Сохранить»?

1 Ответ

6 голосов
/ 04 мая 2010

Вы можете использовать ADO и некоторый код.

Вот некоторые заметки.

Допустим, у вас есть такие данные:

Sub GetMDB()
Dim cn As Object
Dim rs As Object

strFile = "C:\Docs\DBFrom.mdb"
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

strSQL = "SELECT * FROM Table1"
rs.Open strSQL, cn

With Worksheets(7)
    For i = 0 To rs.Fields.Count - 1
        .Cells(1, i + 1) = rs.Fields(i).Name
    Next

    rs.MoveFirst
    .Cells(2, 1).CopyFromRecordset rs
End With
End Sub

Вы можете обновить данные с помощью ADO следующим образом:

Sub UpdateMDB()
Dim cn As Object
Dim rs As Object

''It wuld probably be better to use the proper name, but this is
''convenient for notes
strFile = Workbooks(1).FullName

''Note HDR=Yes, so you can use the names in the first row of the set
''to refer to columns
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
        & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

''Selecting the cell that are different
strSQL = "SELECT * FROM [Sheet7$] s " _
    & "INNER JOIN [;Database=c:\Docs\DBFrom.mdb;].Table1 t " _
    & "ON s.id=t.id " _
    & "WHERE s.Field1<>t.Field1"

rs.Open strSQL, cn, 1, 3 ''adOpenKeyset, adLockOptimistic

''Just to see
''If Not rs.EOF Then MsgBox rs.GetString

''Editing one by one (slow)
rs.MoveFirst
Do While Not rs.EOF
    rs.Fields("t.Field1") = rs.Fields("s.Field1")
    rs.Update
    rs.MoveNext
Loop

''Batch update (faster)
strSQL = "UPDATE [;Database=c:\Docs\DBFrom.mdb;].Table1 t " _
    & "INNER JOIN [Sheet7$] s " _
    & "ON s.id=t.id " _
    & "SET t.Field1=s.Field1 " _
    & "WHERE s.Field1<>t.Field1 "

cn.Execute strSQL

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...