Выгрузка из таблицы SQL в *.CSV через vbs
Формулировка задачи:
Товарищи, помогите. В VBS описан код выгрузки из некой таблицы на SQL в Excel. Поставлена задача выгружать не в Excel, а в файл *.CSV
Изначальный код таков:
'Создаём экселевский файл
Set objExcel = CreateObject("Excel.Application")
objExcel.SheetsInNewWorkbook = 1 'Один лист в книге
Set objWb = objExcel.Workbooks.Add
Set objWs = objWb.Worksheets(1)
objExcel.Visible = false
'Заполняем поля
objExcel.Cells(1, 1).Value = "Высшее подразд."
objExcel.Cells(1, 2).Value = "Подразд."
objExcel.Cells(1, 3).Value = "Код Подразд."
objExcel.Cells(1, 4).Value = "Описание"
objExcel.Cells(1, 5).Value = "Таб. номер"
objExcel.Cells(1, 6).Value = "Фамилия"
objExcel.Cells(1, 7).Value = "Имя"
objExcel.Cells(1, 8).Value = "Отчество"
objExcel.Cells(1, 9).Value = "Вход"
objExcel.Cells(1, 10).Value = "Точка прохода"
objExcel.Cells(1, 11).Value = "Норма"
objExcel.Cells(1, 12).Value = "Расписание Вход"
objExcel.Cells(1, 13).Value = "Нарушил распорядок на"
objExcel.Cells(1, 14).Value = "Расписание Выход"
objExcel.Cells(1, 15).Value = "Выход"
'Форматируем поля
objWs.Range("A1:O1").Font.Bold = True
objWs.Columns("A:O").AutoFit
'Подключаемся к базе данных
set Connection1 = CreateObject("ADODB.Connection")
Connection1.Open("Provider=SQLOLEDB;Data Source=********;" & _
"Trusted_Connection=no;Initial Catalog=*******;" & _
"User ID=sa;Password=********;")
'Set rs = Connection1.Execute("_kpp_to_galaxy_demo_2")
Set rs = Connection1.Execute("select parent.f$name, t$katpodr.f$name,left(t$katpodr.f$kod,5),t1.t_dis, t1.t_n, t1.fam,t1.imya, t1.otch,t1.t_e,t1.t_name_in,t1.t_time_in,t_g_in,t1.t_late_in,t1.t_g_out,t1.t_ex from kpp_galaxy_test t1 join t$lschet on t1.t_n = t$lschet.f$tabn join t$katpodr on t$lschet.f$cex = t$katpodr.f$nrec inner join t$katpodr parent on t$katpodr.f$cpodr = parent.f$nrec ")
'Копируем данные из запроса в эксель
objWs.Range("A2").CopyFromRecordset rs
'Форматим столбцы
objWs.Cells.Select
objExcel.Selection.Columns.AutoFit
objWs.Range("A1").Select
'Сваливаем отсюда и сейвим докуметн
filename = "c:\Отчёт за"+"_"+Cstr(left(Now-1,10))+".XLS"
On Error Resume Next
objWb.SaveAs(filename)
objWb.Close
Set rs = Connection1.Execute("delete from kpp_galaxy_test")
Set rs = Nothing
set objWb = nothing
set objExcel = nothing
//затем полученый файл рассылаем по списку рассылки по e-mail
'Запускаем на исполнение
ReadMail filename
Изначальный код таков:
'Создаём экселевский файл
Set objExcel = CreateObject("Excel.Application")
objExcel.SheetsInNewWorkbook = 1 'Один лист в книге
Set objWb = objExcel.Workbooks.Add
Set objWs = objWb.Worksheets(1)
objExcel.Visible = false
'Заполняем поля
objExcel.Cells(1, 1).Value = "Высшее подразд."
objExcel.Cells(1, 2).Value = "Подразд."
objExcel.Cells(1, 3).Value = "Код Подразд."
objExcel.Cells(1, 4).Value = "Описание"
objExcel.Cells(1, 5).Value = "Таб. номер"
objExcel.Cells(1, 6).Value = "Фамилия"
objExcel.Cells(1, 7).Value = "Имя"
objExcel.Cells(1, 8).Value = "Отчество"
objExcel.Cells(1, 9).Value = "Вход"
objExcel.Cells(1, 10).Value = "Точка прохода"
objExcel.Cells(1, 11).Value = "Норма"
objExcel.Cells(1, 12).Value = "Расписание Вход"
objExcel.Cells(1, 13).Value = "Нарушил распорядок на"
objExcel.Cells(1, 14).Value = "Расписание Выход"
objExcel.Cells(1, 15).Value = "Выход"
'Форматируем поля
objWs.Range("A1:O1").Font.Bold = True
objWs.Columns("A:O").AutoFit
'Подключаемся к базе данных
set Connection1 = CreateObject("ADODB.Connection")
Connection1.Open("Provider=SQLOLEDB;Data Source=********;" & _
"Trusted_Connection=no;Initial Catalog=*******;" & _
"User ID=sa;Password=********;")
'Set rs = Connection1.Execute("_kpp_to_galaxy_demo_2")
Set rs = Connection1.Execute("select parent.f$name, t$katpodr.f$name,left(t$katpodr.f$kod,5),t1.t_dis, t1.t_n, t1.fam,t1.imya, t1.otch,t1.t_e,t1.t_name_in,t1.t_time_in,t_g_in,t1.t_late_in,t1.t_g_out,t1.t_ex from kpp_galaxy_test t1 join t$lschet on t1.t_n = t$lschet.f$tabn join t$katpodr on t$lschet.f$cex = t$katpodr.f$nrec inner join t$katpodr parent on t$katpodr.f$cpodr = parent.f$nrec ")
'Копируем данные из запроса в эксель
objWs.Range("A2").CopyFromRecordset rs
'Форматим столбцы
objWs.Cells.Select
objExcel.Selection.Columns.AutoFit
objWs.Range("A1").Select
'Сваливаем отсюда и сейвим докуметн
filename = "c:\Отчёт за"+"_"+Cstr(left(Now-1,10))+".XLS"
On Error Resume Next
objWb.SaveAs(filename)
objWb.Close
Set rs = Connection1.Execute("delete from kpp_galaxy_test")
Set rs = Nothing
set objWb = nothing
set objExcel = nothing
//затем полученый файл рассылаем по списку рассылки по e-mail
'Запускаем на исполнение
ReadMail filename
Решение задачи: «Выгрузка из таблицы SQL в *.CSV через vbs»
textual
Листинг программы
<font color="blue">dim</font> Connection_String, SQL_Statement, Output_File_Name Connection_String = <font color="teal">"DSN=***;UID=***;PWD=****"</font> SQL_Statement =<font color="teal">"select * from sometable"</font> Output_File_Name = <font color="teal">"export.csv"</font> <font color="blue">dim</font> conn, rs, i, fso, fout, field_data <font color="blue">set</font> fso = CreateObject(<font color="teal">"Scripting.FileSystemObject"</font>) <font color="blue">set</font> fout = fso.CreateTextFile(Output_File_Name, True) <font color="blue">set</font> conn = CreateObject(<font color="teal">"ADODB.Connection"</font>) conn.<font color="blue">Open</font> Connection_String <font color="blue">set</font> rs = conn.Execute(SQL_Statement) <font color="blue">for</font> i=<font color="darkblue"><b>0</b></font> <font color="blue">to</font> rs.Fields.Count-<font color="darkblue"><b>1</b></font> <font color="blue">if</font> i><font color="darkblue"><b>0</b></font> <font color="blue">then</font> fout.<font color="blue">Write</font> <font color="teal">","</font> fout.<font color="blue">Write</font> rs.Fields(i).<font color="blue">Name</font> <font color="blue">next</font> fout.WriteLine <font color="blue">do</font> <font color="blue">while</font> <font color="blue">not</font> rs.eof <font color="blue">for</font> i=<font color="darkblue"><b>0</b></font> <font color="blue">to</font> rs.Fields.Count-<font color="darkblue"><b>1</b></font> <font color="blue">if</font> i><font color="darkblue"><b>0</b></font> <font color="blue">then</font> fout.<font color="blue">Write</font> <font color="teal">","</font> field_data = trim(<font color="teal">""</font>&rs(i)) <font color="blue">if</font> instr(field_data, <font color="teal">","</font>) <font color="blue">then</font> field_data = <font color="teal">""</font><font color="teal">""</font> & field_data & <font color="teal">""</font><font color="teal">""</font> fout.<font color="blue">Write</font> field_data <font color="blue">next</font> fout.WriteLine rs.MoveNext <font color="blue">loop</font> rs.<font color="blue">Close</font> conn.<font color="blue">Close</font> fout.<font color="blue">Close</font>
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д