Я использую старый макрос, который отправляет определенный диапазон из Excel в базу данных MS Access, и хотел бы адаптировать его для отправки в базу данных SQL Server.
Старый код (работает очень хорошо, я не автор):
'ExportAccess
Dim db As DAO.Database
Dim Rst As DAO.Recordset
Dim localMDB As String 'this is the address of the access mdb, removed from this snippit
sht = ActiveCell.Worksheet.Name
With Worksheets(sht)
.Range("L1:A" & .Range("A65536").End(xlUp).Row).Name = "Range"
End With
Set db = OpenDatabase(ActiveWorkbook.FullName, False, False, "excel 8.0")
db.Execute "INSERT INTO myTable IN '" & localMDB & "' SELECT * FROM [Range]", dbFailOnError
Моя попытка модификации:
Dim db As DAO.Database 'sql database
Dim rs As DAO.Recordset
Dim bd As DAO.Database 'excel sheet?
Dim Rst As DAO.Recordset
Set db = OpenDatabase("myDatabase", dbDriverNoPrompt, False, "ODBC;DATABASE=DB_Backup;DSN=myDatabase")
sht = ActiveCell.Worksheet.Name
With Worksheets(sht)
.Range("B1:A" & .Range("A65536").End(xlUp).Row).Name = "Range"
End With
db.Execute "INSERT INTO myTable SELECT * FROM [Range]", dbFailOnError
Когда я запускаю свою попытку, она дает ошибку, что мой «диапазон» не определен. Любая помощь будет принята с благодарностью, спасибо!
Диапазон выбирается в Excel после запуска этой части кода. Я не знаю, как проверить, что он возвращает, я попытаюсь понять это. Возможно, лучшим подходом было бы создать несколько переменных и передать их ячейку за ячейкой в базу данных.
Set db = OpenDatabase(ActiveWorkbook.FullName, ...
разве это не запись в Excel, а не в Access?
См., например: stackoverflow.com/questions/43627480/… Другие похожие сообщения на SO: google.com/…
Тим Уильямс, спасибо за ваш ответ. Я думаю, что Парфе (парфе ;-) ) ответил на вопрос. Спасибо, что тоже посмотрели, свободный поток.
@TimWilliams... запрос на добавление вставляется во внешнюю таблицу Access с синтаксисом mytable IN 'C:\path\to\db.mdb
.
@Parfait - спасибо, пропустил это...
Причина, по которой первый блок кода сработал успешно, заключается в том, что вы подключились к Microsoft Access Jet/ACE Engine, который может запрашивать таблицы базы данных Access, рабочие книги Excel и даже текстовые файлы CSV. Обратите внимание, как db
устанавливается непосредственно в книгу Excel, а запрос на добавление взаимодействует с базой данных Access. Этот синтаксис поддерживается только с Jet/ACE Engine.
Однако во втором блоке кода вы подключаетесь к внешней базе данных, а именно к SQL Server, а не к Jet/ACE Engine. Поэтому аналогичный синтаксис не поддерживается. В частности, как указывает ошибка, [Range]
не существует, потому что вы не подключены к книге. Вам нужно будет указать все данные ячейки диапазона в VBA для соответствующего переноса данных. Не путайте SQL Server с MS Office, даже если они являются продуктами одной компании.
Рассмотрим ADO (а не DAO) для параметризация значений. Убедитесь, что столбцы явно названы в SQL-запросе на добавление. Хотя ваш фактический диапазон неизвестен, ниже зацикливается первый столбец диапазона и используется .Offset
для обхода столбцов в текущей строке. Настройте SQL, пределы диапазона, параметры и типы, чтобы привести их в соответствие с фактическими данными.
Sub SQLServerAppend()
' ADD REFERENCE FOR Microsoft ActiveX Data Objects #.# Library
Dim con As ADODB.Connection, cmd As ADODB.Command
Dim cell As Range
Dim strSQL As String
Set con = New ADODB.Connection
con.Open "DSN=myDatabase"
' PREPARED STATEMENT WITH QMARK PLACEHOLDERS
strSQL = "INSERT INTO myTable (Col1, Col2, Col3, ...) " _
& " VALUES (?, ?, ?, ...)"
sht = ActiveCell.Worksheet.Name
With Worksheets(sht)
For Each cell In .Range("A1", .Range("A1").End(xlDown))
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = con
.CommandText = strSQL
.CommandType = adCmdText
' BIND PARAMETERS WITH ? IN SQL (ALIGN VALUES TO ADO TYPES)
' FIRST COLUMN OF ROW RANGE
.Parameters.Append .CreateParameter("col1param", adVarChar, adParamInput, , cell.Offset(0, 0).Value)
' SECOND COLUMN OF ROW RANGE
.Parameters.Append .CreateParameter("col2param", adDate, adParamInput, , cell.Offset(0, 1).Value)
' THIRD COLUMN OF ROW RANGE
.Parameters.Append .CreateParameter("col3param", adDecimal, adParamInput, , cell.Offset(0, 2).Value)
'... ADD OTHER COLUMNS
' RUN APPEND ACTION
.Execute
End With
Next cell
cmd.close: con.Close
Set cmd = Nothing: Set con = Nothing
End Sub
Парфе, мерси. Я попробую это прямо сейчас!
Привет @Parfait, я попробовал этот код и не могу его запустить. Я обязательно добавил/включил ActiveX Reference 6.1. Отладчик выдает мне ошибку в строке «cmd.Close: con.Close» и говорит, что «Метод или элемент данных не найден». Любые идеи?
Этот бит ".Range("B1:A" & .Range("A65536")" что возвращает .Range("A65536")?