Импорт из excel

[Djuleta86]

Всем привет. Помогите пожалуйста. У меня проблема. Есть файл excel - 123.xls, который состоит из нескольких листов. Нужно периодически импортировать колонки 8, 10, 13, 15 из листа 6 в access таблицу table1. Причем таблица должна обновляться, а не перезаписывать. Т.е. как-бы Причем сумма в колоноке 15 должна не заменяться, а плюсоваться.
Я в vba новичок. Кое-что накатала, но это совсем не то.

Private Sub Кнопка0_Click()

Dim rstN As ADODB.Recordset

Dim xlObj, xlWB As Object

Set xlObj = CreateObject("Excel.Application")
xlObj.Visible = False
Set xlWB = xlObj.Workbooks.Open("f:\123.xls")

Set rstN = New ADODB.Recordset

rstN.Open "table1", CurrentProject.Connection, adOpenDynamic, adLockOptimistiс

If rstN.BOF = False Then
i = 11
While xlWB.Sheets(6).Cells(i, 1) <> ""
rstN.Update "Телефон", xlWB.Sheets(6).Cells(i, 8)
rstN.Update "Дата", xlWB.Sheets(6).Cells(i, 10)
rstN.Update "Сумма1", xlWB.Sheets(6).Cells(i, 13)
rstN.Update "Сумма2", xlWB.Sheets(6).Cells(i, 15)
i = i + 1
MsgBox "Процес окончен"
Wend
Else

With xlWB.Sheets(6).Cells(i, 8)
For i = 11 To .UsedRange.Rows.Count
rstN.Update "Телефон", xlWB.Sheets(6).Cells(i, 8)
rstN.Update "Дата", xlWB.Sheets(6).Cells(i, 10)
rstN.Update "Сумма1", xlWB.Sheets(6).Cells(i, 13)
rstN.Update "Сумма2", xlWB.Sheets(6).Cells(i, 15)
rstN.MoveNext
Next i
End With
MsgBox "Процесс окончен"
End If
Set xlWB = Nothing
Set xlObj = Nothing


End Sub



Excel-файл на всяк. случай прикрепляю. Помогите, please. 3 дня уже над этим сижу и туплю

[Nulex]

Насколько важно требование по перезаписи? Если не важно docmd вполне может помочь.
Если важно (данные меняются в table1 а в excel нет) можно импортировать эксельку во временную таблицу обработать ее напильником SQL и вставить в нужную.

[Chris D]

On Error Resume Next

Dim dbs As DAO.Database
Dim cPath, counter As Integer

Const sFilePath = "C:\Total\"


    Set dbs = CurrentDb

    dbs.Execute "DELETE FROM Table1 Name;"
    
    With CreateObject("Excel.Application")
    cPath = .GetOpenFilename("Excel Files (*.xls), *.xls", , "Aiaaaeou Oaaeeou", , True)
    If Not IsArray(cPath) Then End
        For counter = 1 To UBound(cPath)
        DoCmd.TransferSpreadsheet acImport, 8, "Table1", cPath(counter), True, ""
    Next
    End With
    dbs.Close

Как один из вариантов
Писал в блокноте, заранее прошу прощения за возможные ошибки.

[Djuleta86]

Сообщение от Nulex

Насколько важно требование по перезаписи? Если не важно docmd вполне может помочь.
Если важно (данные меняются в table1 а в excel нет) можно импортировать эксельку во временную таблицу обработать ее напильником SQL и вставить в нужную.

Не, DoCmd точно не подойдет. Во первых надо выкинуть шапку, во вторых перезапись очень важна. Это одна из главных задач. Ща попробую тем способом, который вы подсказали. Огромное спасибо за помощь. Как что получится, обязательно выложу.

[Djuleta86]

Сообщение от Chris D

On Error Resume Next

Dim dbs As DAO.Database
Dim cPath, counter As Integer

Const sFilePath = "C:\Total\"


    Set dbs = CurrentDb

    dbs.Execute "DELETE FROM Table1 Name;"
    
    With CreateObject("Excel.Application")
    cPath = .GetOpenFilename("Excel Files (*.xls), *.xls", , "Aiaaaeou Oaaeeou", , True)
    If Not IsArray(cPath) Then End
        For counter = 1 To UBound(cPath)
        DoCmd.TransferSpreadsheet acImport, 8, "Table1", cPath(counter), True, ""
    Next
    End With
    dbs.Close

Как один из вариантов
Писал в блокноте, заранее прошу прощения за возможные ошибки.

О,спасибо огромное спасибо за код .Сейчас попробую этим способом. Большое спасибо за то, что отозвались на призыв о помощи

[Teslenko_EA]

Здравствуйте Djuleta86.
возможно стоит рассмотреть вариант подключения к диапазону таблицы:

SELECT F8, F10, [Сумма вознаграждения за текущий период] as F13, [Всего] as F15
FROM ["Excel 8.0;DATABASE=C:\Documents and Settings\User\Мои документы\123.xls"].[Приложение 5 $A10:R20000]
WHERE F8 Is Not Null

это может быть сохраненный запрос, данными из которого будет обновляться таблица Table1.
Но идея "..таблица должна обновляться, а не перезаписывать.. ..в колонке 15 должна не заменяться, а плюсоваться. .." не правильное решение.
Сохраняйте все данные с учетом уникальности составного ключа (например Номер телефона абонента, Дата заключения договора,...),
т.к. "плюсоваться" (приплюсовывать) данные из поля F15 необходимости нет,
для этого существуют запросы с группировкой, которые в любой момент могут отобразить итоговое значение.
это моё мнение, решение за Вами.

Евгений.

[Djuleta86]

Сообщение от Teslenko_EA

Здравствуйте Djuleta86.
возможно стоит рассмотреть вариант подключения к диапазону таблицы:

SELECT F8, F10, [Сумма вознаграждения за текущий период] as F13, [Всего] as F15
FROM ["Excel 8.0;DATABASE=C:\Documents and Settings\User\Мои документы\123.xls"].[Приложение 5 $A10:R20000]
WHERE F8 Is Not Null

это может быть сохраненный запрос, данными из которого будет обновляться таблица Table1.
Но идея "..таблица должна обновляться, а не перезаписывать.. ..в колонке 15 должна не заменяться, а плюсоваться. .." не правильное решение.
Сохраняйте все данные с учетом уникальности составного ключа (например Номер телефона абонента, Дата заключения договора,...),
т.к. "плюсоваться" (приплюсовывать) данные из поля F15 необходимости нет,
для этого существуют запросы с группировкой, которые в любой момент могут отобразить итоговое значение.
это моё мнение, решение за Вами.

Евгений.

Спасибо огромное, Евгений. Идея отличная. По времени будет гораздо быстрее обрабатываться, мне кажется.Займусь ее реализацией.