ник: час
или вот ещё
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:\Access\d word\еуче.doc" ' по умолчанию
' 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
