Sub Insert_In_Table()
'https://msdn.microsoft.com/en-us/library/windows/desktop/ms677209%28v=vs.85%29.aspx
'Производит подключение к БД и выполняет какой-либо скрипт без подключение библиотеки ACTIVEX data ojects 6.0
Dim cn As Object
Dim cmd As Object
Dim strSQL As String
Dim sh1 As Worksheet
Dim iRow As Long
Dim ADOErr, r
Debug.Print Now
Set cn = CreateObject("ADODB.Connection")
cn.Provider = "MSDAORA"
cn.ConnectionString = "User ID=********;Password=********;Data Source=*******"
On Error GoTo CnErrorHandler
cn.Open
'Явно начинаем транзакцию во избежание режима AutoCommit=ON
cn.BeginTrans
'Создаем команду
Set cmd = CreateObject("ADODB.Command")
cmd.ActiveConnection = cn
cmd.CommandText = _
"insert into analytics.test_chernin_u(code_wares, name_,supplier,article,group_,old_,code,format,date_rep,code_shop) values (?,?,?,?,?,?,?,?,?,?)"
'Для упрощения примера считаем, что данные находятся в столбцах A1 и J1 первого в книге листа
'Создаем соответствующий Range-объект
Set sh1 = ThisWorkbook.Sheets("Лист1")
Set r = sh1.Range(sh1.[A1], sh1.[J1].End(xlDown))
'Set parameter = command.CreateParameter (Name, Type, Direction, Size, Value)
cmd.Parameters.Append cmd.CreateParameter("code_wares", 131, 1) 'Тип INTEGET
cmd.Parameters.Append cmd.CreateParameter("name_", 200, 1, 100) 'Тип VarChar
cmd.Parameters.Append cmd.CreateParameter("supplier", 200, 1, 100)
cmd.Parameters.Append cmd.CreateParameter("article", 200, 1, 100)
cmd.Parameters.Append cmd.CreateParameter("group_", 200, 1, 100)
cmd.Parameters.Append cmd.CreateParameter("old_", 200, 1, 100)
cmd.Parameters.Append cmd.CreateParameter("code", 200, 1, 100)
cmd.Parameters.Append cmd.CreateParameter("format", 200, 1, 100)
cmd.Parameters.Append cmd.CreateParameter("date_rep", 200, 1, 10) 'Тип DATA
cmd.Parameters.Append cmd.CreateParameter("code_shop", 131, 1)
'Проходим по всем заполненным строкам
'В реальных документах строки создаются динамически и впоследствии не удаляются
'поэтому значение созданных строк может отличатьcя от количества заполненных
For iRow = 2 To r.Rows.Count
cmd.Parameters("CODE_WARES").Value = r.Cells(iRow, 1).Value
cmd.Parameters("NAME_").Value = r.Cells(iRow, 2).Value
cmd.Parameters("SUPPLIER").Value = r.Cells(iRow, 3).Value
cmd.Parameters("ARTICLE").Value = r.Cells(iRow, 4).Value
cmd.Parameters("GROUP_").Value = r.Cells(iRow, 5).Value
cmd.Parameters("OLD_").Value = r.Cells(iRow, 6).Value
cmd.Parameters("CODE").Value = r.Cells(iRow, 7).Value
cmd.Parameters("FORMAT").Value = r.Cells(iRow, 8).Value
cmd.Parameters("DATE_REP").Value = r.Cells(iRow, 9).Value
cmd.Parameters("CODE_SHOP").Value = r.Cells(iRow, 10).Value
cmd.Execute
Next iRow
'Сохраняем данные
cn.CommitTrans
'Удаляем команду и закрываем соединение
cn.Close
Set cn = Nothing
Debug.Print Now
Exit Sub
CnErrorHandler:
For Each ADOErr In cn.Errors 'Отладчик ошибок подключения
MsgBox "№ ошибки " & ADOErr.Number & Chr(10) & _
"Описание: " & ADOErr.Description & Chr(10) & _
"Источник: " & ADOErr.Source, vbCritical
Debug.Print "№ ошибки " & ADOErr.Number & Chr(10) & _
"Описание: " & ADOErr.Description & Chr(10) & _
"Источник: " & ADOErr.Source
Next
cn.Close
Set cn = Nothing
End Sub
|