Страницы: 1
RSS
ADO SQL INSERT INTO в другой Excel, Вставить данные из текущего файла в другой файл
 
Добрый день, коллеги!
Столкнулся с проблемой добавления данных в другой файл средствами ADO.

Описание задачи: Есть текущий файл с "лист1". средствами VBA ADO добавляются данные в последнюю строку. Необходимо чтобы эти данные добавлялись и в другую книгу Excel (C:\Книга2.xlsb) на "лист2" через SQL, где есть точно такая же по структуре таблица.

На текущий момент имею код, который VBA пропускает, но данные не перемещает.
Код
Sub dobavit()
   adress2 = "C:\Книга2.xlsb" 'адрес новой книги
   Set rst = CreateObject("ADODB.Recordset")
      rst = "INSERT INTO [Лист2$] IN '" & adress2 & "' 'Excel 12.0;' SELECT * FROM Лист1"       'из текущего листа1 в книгу2.лист2
End Sub

В интернете нашел подобные решения, но у меня они не работают для вставки в Excel
вставка в Excel:
https://support.microsoft.com/ru-ru/help/295646/how-to-transfer-data-from-ado-data-source-to-excel-w...
https://msdn.microsoft.com/en-us/library/office/ff834799.aspx

вставка в Access:
http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=76831&amp...

Прошу помощи.
 
Возможно ошибаюсь, но не нужно ли в adress2 добавить имя листа?
Согласие есть продукт при полном непротивлении сторон
 
На Сайте Microsoft строка заканчивается книгой и выглядит так:
Код
strSQL = "INSERT INTO [Sheet1$] IN '" & App.Path & _    "\book1.xls' 'Excel 8.0;' SELECT * FROM Customers"
 
Я в этом не специалист, но может нужно
Код
rst.update
?

Скрытый текст
Изменено: Hugo - 23.11.2017 13:47:09
 
Но там же есть и такой синтаксис
Код
strSQL = "SELECT * INTO [Excel 8.0;Database=" & App.Path & _ 
    "\book1.xls].[Sheet1] FROM Customers"
Может стоит попробовать?  
Согласие есть продукт при полном непротивлении сторон
 
Имя листа попробовал указать - данную строку пропускает и не добавляет. А дальше

rst.update - У меня ошибку выдает (Run-time error '424': Object required)
 
Вот еще неработающий результат моих стараний
Код
Sub vstrechaREFRESH()
Dim str As String
Set cnSrc = CreateObject("ADODB.Connection")
    cnSrc.Open ("Provider=Microsoft.ACE.OLEDB.12.0; Data Source=C:\Users\admin\Desktop\Работа\Тест Шаблон.xlsb; Extended Properties=""Excel 12.0;HDR=NO;IMEX=1""")
    strSQL = "SELECT * INTO [Excel 12.0;Database=" & ThisWorkbook.FullName & "].[Встречи] FROM [Встречи]"
    cnSrc.Execute strSQL
End Sub
C:\Users\admin\Desktop\Работа\Тест Шаблон.xlsb - новая книга
Встречи - название листа в обоих книгах

cnSrc.Execute strSQL - ошибка: Объект "Встречи не найден ядром СУБД Microsoft Access. Убедитесь, что объект существует, а его имя и путь к нему указаны правильно. Если объект "встречи" не является локальным, проверьте сетевое подключение или обратитесь к администратору сервера.
 
На оба файла взглянуть можно?
 
Вложил
 
Доброе время суток.
Что-то вы как-то не так запрос на добавления записей в существующую таблицу формируете. Последняя версия так вообще создание таблицы из запроса, и имена листов указываете не верно. :)
Пример на статичных путях к файлам
Код
Public Sub test()
    Dim pConn As Object
    Dim sSQL As String
    Set pConn = CreateObject("ADODB.Connection")
    pConn.Open "DBQ=c:\Path\Тест Шаблон.xlsb;Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};ReadOnly=0;"
    sSQL = "Insert Into [Встречи$]"
    sSQL = sSQL & " Select * From [Excel 12.0;Database=c:\Path\Первый файл.xlsb].[Встречи$]"
    pConn.Execute sSQL, 128
    pConn.Close
End Sub

Успехов.
 
Ураааа спасибо большое. 2 дня мучился над проблемой. :D  
 
Андрей разобрался в логике, а я так и не понял что к чему.В теме одно написано, в макросе другое
 
Добрый день!
Сделал аналогичный запрос на изменение конкретной ячейки в другом файле .xlsm с общим доступом.
Проблема в том, что непосредственно после выполнения команды файл можно открыть только для чтения. Вычитал, что это происходит из-за того, что метод .Close() не выгружает файл из памяти, а лишь закрывает к нему открытое соединение.
При этом, обнаружилось, что в открытом только для чтения (изменённом) файле изменённая ячейка не изменена. Она меняется спустя некоторое время, предполагаю, что только после выгрузки из памяти файла, то есть, когда он становится доступным.
Кто-то сталкивался с такой проблемой? Можно ли как-то выгрузить файл из памяти после .Close() ?
Код
Public Sub TabNExchange()
    Dim pConn As Object, sName As String, sTabel As String, sSQL As String, sCommandText As String
    sName = Worksheets("Работник").Range("F9")
    sTabel = InputBox("Введите таб.N " & sName, 1)
    sCommandText = "UPDATE [TBN$] SET TabelN ='" + sTabel & "' WHERE Rabotnik ='" + sName & "'"
    Set pConn = CreateObject("ADODB.Connection")
    pConn.Open "DBQ=\\Server\FTP\rabtab.xlsm;Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};ReadOnly=0;"
    sSQL = sCommandText
    MsgBox (sSQL) 'проверяем строку запроса SQL
    pConn.Execute sSQL, 128
    pConn.Close
    Set pConn = Nothing
End Sub
 
Цитата
Sandero написал:
файл можно открыть только для чтения
У вас хотя бы открыть что-то можно, а у нас и файла-то никакого нет. Предлагаете для исследования вопроса создать заинтересовавшимся самостоятельно?
Изменено: Андрей VG - 18.04.2020 17:39:29
 
Цитата
Андрей VG написал:
Предлагаете для исследования вопроса создать заинтересовавшимся самостоятельно?
Нет, создал для примера файлы.

Заметил, что изменения вносятся примерно через 1 (+/-) мин после завершения макроса, и файл снова в полном доступе.
Изменено: Sandero - 18.04.2020 18:26:32
 
Хех, описался я тогда, запятой ещё одной перед 128 не хватает. Приношу свои извинения, спешка-с.
Код
Public Sub TabNExchange()
    Dim pConn As Object, sName As String, sTabel As String, sSQL As String, sCommandText As String
    sName = Worksheets("Работник").Range("F9")
    sTabel = InputBox("Введите табельный.N " & sName, 1)
    sCommandText = "UPDATE [TBN$] SET TabelN ='" + sTabel & "' WHERE Rabotnik ='" + sName & "'"
    Set pConn = CreateObject("ADODB.Connection")
    pConn.Open "DBQ=C:\Path\xlsms\rabtab.xlsm;Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};ReadOnly=0;"
    sSQL = sCommandText
    MsgBox (sSQL) 'проверяем строку SQL
    pConn.CursorLocation = 3
    pConn.Execute sSQL, , 128
    pConn.Close
    Set pConn = Nothing
End Sub

С другой стороны - а почему бы вам самому в Object Browser не посмотреть, что там к чему в методе Execute? Зачем же идти путём шамана?
 
документацию на Execute изучил, видел, что у Вас не хватает запятой, но добавляя её ничего не меняется, в Execute важен только CommandText, поэтому пришёл к выводу, что одна или две запятых не влияет результат... :)

Попробовал через ADODB.Command - эффект тот же...

Кстати, вы добавили ещё pConn.CursorLocation = 3 изначально его тоже не было, но и это не влияет
Также не влияет значение Options "-1" в Execute...  
 
Цитата
Sandero написал:
не влияет результат...
Ну, не знаю, не знаю. Добавил и у меня стало работать (Excel 365 64bit). Положите файлы как у меня в папку C:Path\xlsms и поэкспериментируйте.
 
Добрый день!
У меня такой вопрос.
Мне нужно из хранимой процедуры одного сервера SQL записать данные в таблицу на другой сервер SQL.
Я попробовал
Sub Test()

Dim conn As String
Dim data_base As String
Dim period As String
Dim datasource As String
Dim object_id As String
Dim dt As Integer
Dim day_start  As String
Dim date_beg  As String
Dim date_end  As String



conn = "Provider=SQLOLEDB.1;Password=Knpz_asrmb;Persist Security Info=True;User ID=USER_ASRMB;Initial Catalog=TCD_Work;Data Source=Sam-knpz-app24"
conn1 = "Provider=SQLOLEDB.1;Password=ASRMB;Persist Security Info=True;User ID=ASRMB;Initial Catalog=dbm_asrmb_knpz_20190129;Data Source=KNPZ-ASRMB-N1\MSSQLASRMB1"


JS_params = "{" + Chr(34) + "id_object" + Chr(34) + ":" + Chr(34) + object_id + Chr(34) + "," _
  + Chr(34) + "period" + Chr(34) + ":" + Chr(34) + period + Chr(34) + "," _
  + Chr(34) + "datasource" + Chr(34) + ":" + Chr(34) + CStr(dt) + Chr(34) + "," _
  + Chr(34) + "date" + Chr(34) + ":" + Chr(34) + day_start + Chr(34) + "," _
  + Chr(34) + "date_beg" + Chr(34) + ":" + Chr(34) + date_beg + Chr(34) + "," _
  + Chr(34) + "date_end" + Chr(34) + ":" + Chr(34) + date_end + Chr(34) + "}"
 
Query conn, JS_params

End Sub

Sub Query(connStr As String, jsonParams As String)



Dim cnDB As New ADODB.Connection
Dim rc As New ADODB.Recordset
cnDB.CommandTimeout = 360
cnDB.Open connStr

Dim params As Object
Set params = JsonConverter.ParseJson(jsonParams)

Dim period  As String
Dim object_id  As String
Dim day_start  As String
Dim date_beg  As String
Dim date_end  As String
Dim data_source  As String
Dim dataseg As String
Dim day1 As String
Dim month1 As String
Dim year1 As String
Dim dt As String


dataseg = Date
ThisWorkbook.Sheets(2).Cells(1, 2).Value = dataseg
day1 = Day(dataseg)
month1 = Mid(dataseg, 4, 2)
year1 = year(dataseg)
ThisWorkbook.Sheets(2).Cells(2, 1).Value = day1
ThisWorkbook.Sheets(2).Cells(3, 1).Value = month1
ThisWorkbook.Sheets(2).Cells(4, 1).Value = year1
dt = year1 + month1 + day1
ThisWorkbook.Sheets(2).Cells(5, 1).Value = dt




period = params("period" ;)

object_id = params("id_object" ;)

data_source = params("datasource" ;)

date_beg = params("date_beg" ;)

date_end = params("date_end" ;)

day_start = params("date" ;)




Dim ws As Worksheet

'Set ws = Sheets("Áàëàíñ ïî çàâîäó" ;)

'ws.UsedRange.Clear

Dim sql As String

sql = "set nocount on EXEC spTCD__KNPZ_shipment '" + dt + "',1"

rc.Open sql, cnDB
ThisWorkbook.Sheets(1).Cells(1, 1).CopyFromRecordset rc
rc.Close
cnDB.Close



Dim cn1DB As New ADODB.Connection
Dim rc1 As New ADODB.Recordset
cn1DB.CommandTimeout = 360
cn1DB.Open "Provider=SQLOLEDB.1;Password=ASRMB;Persist Security Info=True;User ID=ASRMB;Initial Catalog=dbm_asrmb_knpz_20190129;Data Source=KNPZ-ASRMB-N1\MSSQLASRMB1"

Dim sql2 As String

sql2 = "Insert INTO [dbm_asrmb_knpz_20190129].[dbo].[tsd] (id_prod, prod_name, prod_okp,prod_ksm, id_transType, transtype, id_owner, owner, m_netto, shipDT) From rsADO"


rc1.Open sql2, cn1DB
ThisWorkbook.Sheets(3).Cells(1, 1).CopyFromRecordset rc1
rc1.Close
cn1DB.Close



В один рекордсет я записал данные. Но не могу записать из него в таблицу
Страницы: 1
Наверх