| |
|
|
| | есть у меня универсальная процедурка для экпорта в Excel
Public Function Export_RecordSet_to_Excel_DAO(varRecordset As dao.Recordset, Optional lStartColumn As Long = 0, Optional bAutoFilter As Boolean = False) As Boolean
' экспорт содержимого рекордсета в Excel
'
' Вход:
' varRecordset - рекордсет с данными
' lStartColumn - номер первого выводимого столбца (начиная с 0)
' bAutoFilter - выставлять автофильтр?
On Error GoTo Err_Debug
Dim xlsApp As Object
Dim xlsBook As Object
Dim xlsSheet As Object
Dim RcsCols As Long
Dim iCols As Long
Dim lResult As String
DoCmd.Hourglass True
If varRecordset.RecordCount = 0 Then
MsgBox "Выборка пуста."
GoTo Exit_Here
Else
RcsCols = varRecordset.Fields.Count
varRecordset.MoveLast
varRecordset.MoveFirst
End If
Set xlsApp = CreateObject("Excel.Application")
Set xlsBook = xlsApp.Workbooks.Add
Set xlsSheet = xlsBook.Worksheets(1)
xlsApp.Application.ReferenceStyle = -4150
xlsSheet.Activate
' xlsApp.Visible = True
With xlsSheet
For iCols = 0 To RcsCols - 1 - lStartColumn
.Cells(1, iCols + 1).VALUE = varRecordset.Fields(iCols + lStartColumn).Name
Next
.Range(.Cells(1, 1), .Cells(1, RcsCols - lStartColumn)).Font.Bold = True
For irows = 1 To varRecordset.RecordCount
For iCols = 0 To RcsCols - 1 - lStartColumn
Select Case varRecordset.Fields(iCols + lStartColumn).type
Case dbDate
xlsSheet.Cells(irows + 1, iCols + 1).NumberFormat = "dd/mm/yy h:mm;@"
xlsSheet.Cells(irows + 1, iCols + 1).VALUE = CDate(varRecordset.Fields(iCols + lStartColumn).VALUE)
Case Else
xlsSheet.Cells(irows + 1, iCols + 1).NumberFormat = ""
xlsSheet.Cells(irows + 1, iCols + 1).VALUE = varRecordset.Fields(iCols + lStartColumn)
End Select
' Debug.Print varRecordset(iCols + lStartColumn).type & "-" & varRecordset(iCols + lStartColumn)
Next
varRecordset.MoveNext
Next
.Cells.Select
.Cells.EntireColumn.AutoFit
.Cells(1, 1).Select
.Range(.Cells(1, 1), .Cells(1, RcsCols - lStartColumn)).Interior.ColorIndex = 15
.Range(.Cells(1, 1), .Cells(1, RcsCols - lStartColumn)).Interior.Pattern = xlSolid
.Range(.Cells(1, 1), .Cells(irows + 1, RcsCols - lStartColumn)).EntireColumn.AutoFit
End With
If bAutoFilter Then
xlsApp.Selection.AutoFilter
End If
xlsApp.Visible = True
Export_RecordSet_to_Excel_DAO = True
Exit_Here:
DoCmd.Hourglass False
Set xlsSheet = Nothing
Set xlsBook = Nothing
Set xlsApp = Nothing
Exit Function
Err_Debug:
MsgBox "Ошибка! Возможно данные выгружение некорректно. " & Err.Description
Export_RecordSet_to_Excel_DAO = False
Resume Exit_Here
End Function
|
ПРОБЛЕМА:
Если в запросе есть поля длиннее 255 символов, то выводит только 255, а дальше кракозябры.
Нашел информацию что это официальный баг мелкософта.
Пробывал различные пути решения:
Вариант UNION с таблицей где memo поля не прошел.
Вариант с разбиением по разным полям не подходит, т.к. теряется универсальность решения.
Кто нибудь сталкивался? Как побороли? | |
| |
| |
| |
|
|
| | сталкивался и не раз,
так и не решил - обрезаю первые 255 символов :( | |
| |
| |
| |
|
|
| |
Вариант UNION с таблицей где memo поля не прошел.
|
Почему?
Как частный вариант для текста, где преобладает кирилица - применить в запросе к сборному полю функцию StrConv("....", 128), где 128, это vbFromUnicode, а при обработке Recordset-a выполнить обратное преобразование. Так можно впихнуть максимум 511 символов.
В вашем случае прийдется преобразовать все поля или проверять на выходе содержимое каждой полученной строки.
Что касается самой стратегии экспорта в Excel, то вы выбрали самый долгоиграющий способ с обработкой каждой ячейки. Но это - дело вкуса. | |
| |
| |
