Public Function Fun_TABLE_IN_XLS(STR_TABLE_NAME As String, To_ROTIN As Boolean, TO_MESSING As Boolean)
' переброс таблицы в файл Excel
' To_Rotin = true - показать(открыть) файл
' To_Message = true - сообщить о перебросе
If FUN_Vopros("Выгружаем в файл Excel? ", vbQuestion) = False Then Exit Function
Dim FILE_STROKA As String ' Формируемая строка
Dim lngPID As Variant ' просто переменная
Dim FILE_NAME As String ' имя файла
Dim FIEL As ADODB.Field ' поле
Dim FIEL1 As ADODB.Field ' поле
Dim rst2 As ADODB.Recordset ' набор записей
Set rst2 = New ADODB.Recordset ' набор записей
Dim ConnectionString As String ' Соединение
Dim ExcelConnection As New ADODB.Connection ' Соединение
Dim SQLCommand As String ' Формируемая строка команд
Dim Cmd As New ADODB.Command ' команда
GLB_Patch_REPORT = FUN_OUT_TABLE_String("TUNING_TBL", "Patch", "Папка_Отчетов", "ID")
FILE_NAME = FUN_FILE_NAME_IN(STR_TABLE_NAME, "xls")
FILE_NAME = FUN_Patch_File(GLB_Patch_REPORT, FILE_NAME)
If FUN_FILE_YES_NO(FILE_NAME) = True Then FUN_Delete_File_Name (FILE_NAME)
ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Excelеtest.xls;Extended Properties=Excel 8.0"
ExcelConnection.Open ConnectionString
rst2.Open "SELECT " & STR_TABLE_NAME & ".* FROM " & STR_TABLE_NAME & " WITH OWNERACCESS OPTION;", GLB_con, adOpenKeyset, adLockOptimistic
If rst2.EOF = False Then ' если таблица (rst2) не пуста перенос
FILE_STROKA = ""
' названия столбцов (заголовки)
For Each FIEL In rst2.Fields
FILE_STROKA = FILE_STROKA & "[" & FIEL.Name & "] TEXT(150), "
Next FIEL
FILE_STROKA = Mid(FILE_STROKA, 1, Len(FILE_STROKA) - 2)
SQLCommand = "CREATE TABLE sheet1 (" & FILE_STROKA & ")"
Cmd.ActiveConnection = ExcelConnection
Cmd.CommandText = SQLCommand
Cmd.Execute
For Each FIEL1 In rst2.Fields 'значения
SQLCommand = "INSERT INTO sheet1." & FIEL1.Name & " VALUES (" & FIEL1 & ")"
Cmd.ActiveConnection = ExcelConnection
Cmd.CommandText = SQLCommand
Cmd.Execute
FILE_STROKA = ""
Next FIEL1
End If
rst2.Close
Set rst2 = Nothing
ExcelConnection.Close
Set ExcelConnection = Nothing
|