Программа iNETsHOP - обработка, сравнение, анализ прайс листов поставщиков, создание каталога товаров интернет магазина Форум - Программа iNETsHOP - Работа с программой - Экспорт прайса


http://inetshop.in.ua/index.php?p=showtopic&toid=287&fid=&area=1&print_post=1643
03.02.2016 18:35

MaXX
Пользователь iNETsHOP


Количество сообщений   64
Зарегистрирован:   11-11-2008, 04:35:57 		Экспорт в Excel через VBS
Цитата
Написал: reddimonus
Это в принципе реализуемо, но достаточно сложно.
Можно ли просто получить возможность выполнить некоторый VBA скрипт после уже загрузки данных в EXCEL но до закрытия документа ? По типу импорта прайсов.


Ничего сложного нет. Вот за 30 минут переделал пример сценария VBS для экспорта в Эксель полей: код товара, Название, цена, основаная группа

Замените в примере имя сервера, базу данных, логин и пароль на свои.
Код

Dim oExcelApp, oWorkbook, oSheet
Dim oConn
sPriceEmpty = "C:\TEMP\price1.xls"

Set oConn = CreateObject("ADODB.Connection")
oConn.Open "Driver={SQL Server};Server=127.0.0.1;Database=iNETsHOP;Uid=Administrator;Pwd="
'oConn.Open "Provider=SQLOLEDB;User ID=SA;Password=password;Initial Catalog="iNETsHOP_PL";Data Source="127.0.0.1"
'MsgBox(oConn.Version)


Dim oRcordSet
Set oRcordSet = CreateObject("ADODB.Recordset")
oRcordSet.CursorType = 2
oRcordSet.LockType = 3
oRcordSet.Open "select G_ID, G_NAME, price, GR_FULL_NAME from TBL_GOODS, TBL_GROUPS where G_GR_ID = GR_ID", oConn

Set oExcelApp = CreateObject("Excel.Application")
oExcelApp.Visible = False
oExcelApp.DisplayAlerts = False
oExcelApp.EnableEvents = False
oExcelApp.Visible = False
oExcelApp.AskToUpdateLinks = False

Set oWorkbook = oExcelApp.Workbooks.Open(sPriceEmpty)
'oWorkbook.CheckCompatibility = False

Set oSheet = oWorkbook.Sheets("Лист1")

oSheet.Range("A5").Value = "Код"
oSheet.Range("B5").Value = "Название"
oSheet.Range("C5").Value = "Цена"
oSheet.Range("D5").Value = "Категория"

i = 6
Do While oRcordSet.EOF = 0
oSheet.Range("A" & i).Value = oRcordSet.Fields("G_ID").Value
oSheet.Range("B" & i).Value = oRcordSet.Fields("G_NAME").Value
oSheet.Range("C" & i).Value = oRcordSet.Fields("price").Value
oSheet.Range("D" & i).Value = oRcordSet.Fields("GR_FULL_NAME").Value

oRcordSet.MoveNext
i = i + 1
Loop

oWorkbook.Close True
oExcelApp.Quit

Set oSheet = Nothing
Set oWorkbook = Nothing
Set oExcelApp = Nothing

oConn.Close
Set oRcordSet = Nothing
Set oConn = Nothing


Этот пример переносит занные из sql-запроса "select G_ID, G_NAME, price, GR_FULL_NAME from TBL_GOODS, TBL_GROUPS where G_GR_ID = GR_ID" в пустой файл-шаблон Эксель "C:\TEMP\price1.xls" начиная с 6-й строки и затем спрашивает куда сохранить новый файл.

Если нужно еще вызвать макрос, то после передачи данных из запроса можно дописать
oExcelApp.Application.Run "MarcosName"