ник: час
эт я плохо объяснил(спросил)
Описание: Функция позволяет записывать в текстовые файлы таблицы, запросы (строки SQL) в обход DoCmd.TransferText. Во избежание дополнительных неприятностей не используются такие функции как IIf, Switch, Replace. Входными параметрами являются "Имя таблицы/запроса/строка SQL", "Полное имя файла", "Разделитель полей" и "С именами полей или без". Работает на MSA 2000-2002 (на ранних версиях не проверял в связи с отсутствием таковых)...
Автор: Дедушев Михаил (AKA Deminik)
Добавил на сайт: Deminik 27.09.2004
Option Compare Database
Public Function OutFile(strSQL As String, Optional strFileName _
As String = "", _
Optional strDelimeter As String = ";", _
Optional NeedHead As Boolean = True) As Boolean
' strSQL - строка SQL или имя таблицы/запроса для записи в файл (обяз)
' strFileName - полное имя файла (не обяз)
' strDelimeter - разделитель полей (не обяз)
' NeedHead - с именами полей или без (не обяз)
'Error-handler inserted on 25.09.2004 at 09:20 by Dedushev M.N.
On Error GoTo OutFile_Error
Dim rst As DAO.Recordset, hFile As Long
Dim i As Integer, n As Integer, strText As String
If Len(strFileName) = 0 Then
strFileName = "c:\outfile.txt"
' Lыш цх strFileName = CurrentProject.Path & "\outfile.txt"
End If
Set rst = CurrentDb.OpenRecordset(strSQL)
strText = ""
' Формирование строки заголовка таблицы
With rst
For i = 0 To .Fields.Count - 1
strText = strText & Chr(34) & .Fields(i).Name _
& Chr(34) & strDelimeter
Next i
hFile = FreeFile
' Запись в файл
Open strFileName For Output Access Write As hFile
If NeedHead Then Print #hFile, _
Left(strText, Len(strText) - 1)
' Формирование строк таблицы
Do Until rst.EOF
strText = ""
For i = 0 To .Fields.Count - 1
strText = strText & Chr(34) & .Fields(i).Value _
& Chr(34) & strDelimeter
Next i
Print #hFile, Left(strText, Len(strText) - 1)
.MoveNext
Loop
Close hFile
.Close
End With
' Проверка наличия записанного файла
If Dir(strFileName) <> "" Then OutFile = True
OutFile_Exit:
Exit Function
OutFile_Error:
MsgBox "Непредвиденная разработчиком ошибка - " & Err.Number & _
vbCrLf & vbCrLf & Error$, vbExclamation
Resume OutFile_Exit
End Function