Sub insert1()

Dim Cn As ADODB.connection '* Connection String
Dim oCm As ADODB.Command '* Command Object
Dim sName As String
Dim sLocation As String
Dim iRecAffected As Integer


On Error GoTo ADO_ERROR

Set Cn = New ADODB.connection
Cn.connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= D:\Äàðêøåâè÷\Ïðîãîí ôèíàíñîâîé ÷àñòè ñêîðèíãà\ScoringBase1.accdb;Persist Security Info=False"
'Cn.connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source= X:\013 ÄÅÏ. ÏÎ ÓÏÐÀÂËÅÍÈÞ ÐÈÑÊÀÌÈ\002. Ðàáî÷àÿ ïàïêà\Ñêîðèíã\Áàçà ðåøåíèé\ScoringBase1.accdb;Persist Security Info=False"
Cn.ConnectionTimeout = 40
Cn.Open

ïðîâåðÑòðîêà = 2


Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
   With rs
      .CursorLocation = adUseClient
      .Open "select top 1 * from Applications;", Cn, adOpenStatic, adLockOptimistic
      .AddNew
        Array_Name = Split(ActiveWorkbook.Sheets("zapros").Range("c1").Value, ",")
        Array_Value = Split(ActiveWorkbook.Sheets("zapros").Range("e1").Value, ",")
        
        For i = 0 To UBound(Array_Name)
        
        If Array_Value(i) <> "0" And Array_Value(i) <> "0:00:00" Then
        .Fields(Array_Name(i)).Value = Array_Value(i)
        Else
        .Fields(Array_Name(i)).Value = ""
        End If
        
        Next i

      .Update
      .Close
   End With
   Set rs = Nothing



Set oCm = New ADODB.Command
oCm.ActiveConnection = Cn
'oCm.CommandText = "Insert into Applications " & ActiveWorkbook.Sheets("zapros").Range("c1").Value & "  values  " & ActiveWorkbook.Sheets("zapros").Range("e1").Value
'oCm.Execute iRecAffected
oCm.CommandText = "Insert into Applications1 " & ActiveWorkbook.Sheets("zapros").Range("c5").Value & "  values  " & ActiveWorkbook.Sheets("zapros").Range("e5").Value
oCm.Execute iRecAffected
oCm.CommandText = "Insert into Scoring " & ActiveWorkbook.Sheets("zapros").Range("c9").Value & "  values  " & ActiveWorkbook.Sheets("zapros").Range("e9").Value
oCm.Execute iRecAffected




If iRecAffected = 0 Then
MsgBox "Îøèáêà Äîêóìåíò íå çàðåãèñòðèðîâàí!!!"
End If

If Cn.State <> adStateClosed Then
Cn.Close
Application.StatusBar = False
If Not oCm Is Nothing Then Set oCm = Nothing
If Not Cn Is Nothing Then Set Cn = Nothing
MsgBox ("Äîêóìåíò çàðåãèñòðèðîâàí ïîä íîìåðîì: ¹" & ActiveWorkbook.Sheets("zapros").Range("a3").Value)
Exit Sub
End If

Application.StatusBar = False
If Not oCm Is Nothing Then Set oCm = Nothing
If Not Cn Is Nothing Then Set Cn = Nothing

ADO_ERROR:
If Err <> 0 Then
Debug.Assert Err = 0
MsgBox Err.Description
Err.Clear
Resume Next
End If
End Sub