После прочтения Кодекса, я, наконец, понял, что вы хотели сделать:
Сначала вы хотели проверить, экспортирована строка или нет, прежде чем продолжить
Итак, вот обновленный сценарий.
- Я изменил последовательность нескольких разделов кода, так как они не были связными или будут вызывать у вас ошибки.
- Я добавил столбец H Предположим, что ваши столбцы от A до G, где H будет хранить «Exported» после того, как он был успешно сохранен в базе данных.
Так что теперь это должно работать для вас:
Main Sub Экспорт в Access
Sub Export_Data_Updated()
Dim dbPath As String
Dim lastRow As Long
Dim exportedRowCnt As Long
'add error handling
On Error GoTo exitSub
'Check for data
'##> This should be first as it is useless to open cnx or find path/last row if this will exit the sub
If Sheet1.Range("A2").Value = "" Then
MsgBox " Add the data that you want to send to MS Access"
Exit Sub
End If
'##> Only Continue when the above is fine
'##> Check if the path exits first
'Variables for file path
dbPath = ActiveSheet.Range("J3").Value '##> This was wrong before pointing to I3
If Not FileExists(dbPath) Then
MsgBox "The Database file doesn't exist! Kindly correct first"
Exit Sub
End If
'##> Only then that you can proceed
'find las last row of data
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
'##> Change the Error handler now
Dim cnx As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class
On Error GoTo errHandler
'Initialise the collection class variable
Set cnx = New ADODB.Connection
'Connection class is equipped with a —method— named Open
'—-4 aguments—- ConnectionString, UserID, Password, Options
'ConnectionString formula—-Key1=Value1;Key2=Value2;Key_n=Value_n;
cnx.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
'two primary providers used in ADO SQLOLEDB —-Microsoft.JET.OLEDB.4.0 —-Microsoft.ACE.OLEDB.12.0
'OLE stands for Object Linking and Embedding, Database
'ADO library is equipped with a class named Recordset
Set rst = New ADODB.Recordset 'assign memory to the recordset
'ConnectionString Open '—-5 aguments—-
'Source, ActiveConnection, CursorType, LockType, Options
rst.Open Source:="PhoneList", ActiveConnection:=cnx, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable
'##> Continue reading Database now
'you now have the recordset object
'add the values to it
'Wait Cursor
Application.Cursor = xlWait
'Pause Screen Update
Application.ScreenUpdating = False
'##> Set exportedRowCnt to 0 first
exportedRowCnt = 0
'##> Let's suppose Data is on Column A to G.
' --> So let's put the "Exported" on Column H
For nRow = 2 To lastRow
'##> Check if the Row has already been imported?
'If it it isn't then continue
If IdExists(cnx, Range("A" & nRow).Value) Then
'Item already exported, so update the Status
Range("H" & nRow).Value2 = "Exported"
Else
rst.AddNew 'Add New RecordSet
'Itirating Columns
For nCol = 1 To 7
rst.Fields(Cells(1, nCol).Value2) = Cells(nRow, nCol).Value 'Using the Excel Sheet Column Heading
Next nCol
rst.Update 'Update RecordSet
'##>Update the Status on Column H when the record is successfully updated
Range("H" & nRow).Value2 = "Exported"
'Increment exportedRowCnt
exportedRowCnt = exportedRowCnt + 1
End If
Next nRow
'close the recordset
rst.Close
' Close the connection
cnx.Close
'clear memory
Set rst = Nothing
Set cnx = Nothing
If exportedRowCnt > 0 Then
'communicate with the user
MsgBox exportedRowCnt & " row(s) successfully sent to the access database"
End If
'Update the sheet
Application.ScreenUpdating = True
exitSub:
'Restore Default Cursor
Application.Cursor = xlDefault
'Update the sheet
Application.ScreenUpdating = True
Exit Sub
errHandler:
'clear memory
Set rst = Nothing
Set cnx = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data"
Resume exitSub
End Sub
Функция Проверка наличия файла:
Примечание: теперь действительный идентификатор только Тип строки
Function IdExists(cnx As ADODB.Connection, sId As String) As Boolean
'##> Set IdExists as False and change to true if the ID exists already
IdExists = False
'##> Change the Error handler now
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim cmd As ADODB.Command 'dim the ADO command class
On Error GoTo errHandler
'Sql For search
Dim sSql As String
sSql = "SELECT Count(PhoneList.ID) AS IDCnt FROM PhoneList WHERE (PhoneList.ID='" & sId & "')"
'##> Execute command and collect it into a Recordset
Set cmd = New ADODB.Command
cmd.ActiveConnection = cnx
cmd.CommandText = sSql
'ADO library is equipped with a class named Recordset
Set rst = cmd.Execute 'New ADODB.Recordset 'assign memory to the recordset
'Read First RST
rst.MoveFirst
'##> If rst returns a value then ID already exists
If rst.Fields(0) > 0 Then
IdExists = True
End If
'close the recordset
rst.Close
'clear memory
Set rst = Nothing
exitFunction:
Exit Function
errHandler:
'clear memory
Set rst = Nothing
MsgBox "Error " & Err.Number & " :" & Err.Description
End Function
Примечание: Пожалуйста, прочтите любые комментарии, начинающиеся с «'##>», так как это основные изменения или объяснения, которые вам необходимо понять
Обновления:
Вот файл после обновлений: https://drive.google.com/open?id=1XqEboSFed_6exDwvBZGOqcZWkN8YaslY
* 1 042 *
---> К счастью, вы отправили мне файл, так как я увидел, что DbPath указывает на неправильную ячейку, вызывая ошибку отсутствующего файла. Теперь все исправлено и работает!
Я буду sh вам всего наилучшего!