Типа перевел
А в чем вопрос собственно

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

оказалось - вот так

SQLCommand = "INSERT INTO [Sheet1$] (" & FIEL1.Name & ") VALUES ('" & FIEL1 & "')"

Глянь на рабочий вариант
Может чем поможет

Option Compare Database Public Function PrintFormByTemplate(TmplName As String, ID As Long) As Boolean 'Сформировать и вывести форму по шаблону TmplName по записи о работнике с идентификатором ID 'Шаблоны хранятся в папке Templates в каталоге клиента в формате XlS 'Возвращает Истину, если формирование успешно, Ложь - в противном случае     Dim XL As Object, XLBook As Object, XLSheet As Object     Dim ClientDir As String, TmplFile As String, OutputDir As String, OutputFile As String, Pos As Long     Dim Rst As Object, SubRst As Object, StrN As Long          'Выбрать запись о работнике     Set Rst = CurrentDb.OpenRecordset("SELECT * FROM [Работники] WHERE ID=" & ID)     If Rst.EOF Then         MsgBox "Запись о работнике отсутствует в базе.", , "Ошибка вывода формы " & TmplName         PrintFormByTemplate = False         Exit Function     End If          'Создать копию файла шаблона для заполнения     ClientDir = CurrentDb.Name     Pos = Len(ClientDir)     Do While Mid(ClientDir, Pos, 1) <> "\"         Pos = Pos - 1     Loop     ClientDir = Left(ClientDir, Pos)     TmplFile = ClientDir & "Templates\" + TmplName + ".xls"     If Dir(TmplFile) = "" Then         MsgBox "Не найден файл шаблона.", , "Ошибка вывода формы " & TmplName         PrintFormByTemplate = False         Exit Function     End If     If Dir("C:\Temp", vbDirectory) = "" Then         MkDir "C:\Temp"     End If     OutputDir = "C:\Temp\Персонал.Оперативная статотчетность"     If Dir(OutputDir, vbDirectory) = "" Then         MkDir OutputDir     End If     OutputFile = OutputDir & "\" & TmplName & " " & Rst![Фамилия] & " " & Rst![Имя] & " " & Rst![Отчество] & "  (таб. номер " & Rst![ТабНомер] & ").xls"     FileCopy TmplFile, OutputFile          'Создать объекты Excel On Error GoTo OLEError     Set XL = CreateObject("Excel.Application") On Error GoTo AnyError     Set XLBook = XL.Workbooks.Open(OutputFile)          'Вывод в конкретный шаблон     'Личная карточка работника (унифицированная форма Т-2)     If TmplName = "Т-2" Then                  '1-й лист         Set XLSheet = XLBook.Worksheets(1)         'награды         StrN = 8         Set SubRst = CurrentDb.OpenRecordset("SELECT * FROM [_Награды] WHERE [Работник]=" & ID & " ORDER BY ID")         Do While Not SubRst.EOF             XLSheet.Cells(StrN, 1) = SubRst![Наименование]             XLSheet.Cells(StrN, 33) = SubRst![ДокументНаим]             XLSheet.Cells(StrN, 48) = SubRst![ДокументНомер]             XLSheet.Cells(StrN, 56) = SubRst![ДокументДата]             SubRst.MoveNext             StrN = StrN + 1         Loop         'конец награды     End If     'Конец личная карточка работника (унифицированная форма Т-2)          XLBook.Save     XL.Visible = True     PrintFormByTemplate = True     Exit Function      OLEError:     MsgBox "Microsoft Excel - не установлен.", , "Ошибка вывода формы " & TmplName     PrintFormByTemplate = False     Exit Function AnyError:     MsgBox "Неопознанная ошибка.", , "Ошибка вывода формы " & TmplName     PrintFormByTemplate = False     Exit Function End Function

Оказалось всё вот так:
Выгрузка данных таблицы из MS Access без установленного на машине MS Excel.
Особая благодарность osmor_у

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 DATA_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=" & FILE_NAME & ";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 DATA_STROKA = "" FILE_STROKA = "" If Not rst2.BOF Then rst2.MoveFirst 'SQLCommand = "INSERT INTO [Sheet1] (" & FIEL1.Name & ") VALUES ('" & FIEL1 & "')" 'INSERT INTO [Sheet1$] (F1, F2) values ('111', 'ABC') Do While Not rst2.EOF ' заполняем For Each FIEL1 In rst2.Fields 'значения If NZVB(FIEL1) <> "" Then DATA_STROKA = DATA_STROKA & "'" & FIEL1 & "', " Else DATA_STROKA = DATA_STROKA & "'-', " End If FILE_STROKA = FILE_STROKA & FIEL1.Name & ", " Next FIEL1 DATA_STROKA = Mid(DATA_STROKA, 1, Len(DATA_STROKA) - 2) FILE_STROKA = Mid(FILE_STROKA, 1, Len(FILE_STROKA) - 2) SQLCommand = "INSERT INTO [Sheet1] (" & FILE_STROKA & ") VALUES (" & DATA_STROKA & ")" 'MsgBox DATA_STROKA 'MsgBox FILE_STROKA Cmd.ActiveConnection = ExcelConnection Cmd.CommandText = SQLCommand Cmd.Execute DATA_STROKA = "" FILE_STROKA = "" rst2.MoveNext Loop End If rst2.Close Set rst2 = Nothing ExcelConnection.Close Set ExcelConnection = Nothing If TO_MESSING <> 0 Then Call MsgBox("Готово!!!", vbInformation) If To_ROTIN <> 0 Then lngPID = Shell(Mid(Get_Wind_Patch, 1, 3) & "Program Files\Internet Explorer\iexplore.exe " & FILE_NAME, 1) End Function

таков:

осталось в dbf и в mdb

Кстати как в dbf выгрузить таблицу MS Access
У кого нить есть функция???

Пиво тоже хорошо кончается - струёй в унитаз - КАЙФ!!!!!!