Access2Base - OutputTo method accepts input from array
in addition to tables and queries. (only for internal use - arguments not published in documentation) Change-Id: I4c7aff878a4ff1a03dcc32baae740559d034d3ca
This commit is contained in:
Jean-Pierre Ledure
parent
1ef8ab3ed7
commit
feed5f8a4b
@ -629,8 +629,11 @@ Public Function OutputTo(ByVal pvObjectType As Variant _
|
||||
, ByVal Optional pvTemplateFile As Variant _
|
||||
, ByVal Optional pvEncoding As Variant _
|
||||
, ByVal Optional pvQuality As Variant _
|
||||
, ByRef Optional pvHeaders As Variant _
|
||||
, ByRef Optional pvData As Variant _
|
||||
) As Boolean
|
||||
'Supported: acFormatHTML, acFormatODS, acFormatXLS, acFormatXLSX, acFormatTXT for tables and queries
|
||||
'pvHeaders and pvData (unpublished) when pvObjectType = acOutputArray
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
Const cstThisSub = "Database.OutputTo"
|
||||
@ -638,7 +641,7 @@ Const cstThisSub = "Database.OutputTo"
|
||||
|
||||
OutputTo = False
|
||||
|
||||
If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), Array(acOutputTable, acOutputQuery)) Then Goto Exit_Function
|
||||
If Not Utils._CheckArgument(pvObjectType, 1, Utils._AddNumeric(), Array(acOutputTable, acOutputQuery, acOutputArray)) Then Goto Exit_Function
|
||||
If IsMissing(pvObjectName) Then Call _TraceArguments()
|
||||
If Not Utils._CheckArgument(pvObjectName, 2, vbString) Then Goto Exit_Function
|
||||
If IsMissing(pvOutputFormat) Then pvOutputFormat = ""
|
||||
@ -663,13 +666,21 @@ Const cstThisSub = "Database.OutputTo"
|
||||
If Not Utils._CheckArgument(pvEncoding, 7, _AddNumeric()) Then Goto Exit_Function
|
||||
If IsMissing(pvQuality) Then pvQuality = acExportQualityPrint
|
||||
If Not Utils._CheckArgument(pvQuality, 7, _AddNumeric(), Array(acExportQualityPrint, acExportQualityScreen)) Then Goto Exit_Function
|
||||
If pvObjectType = acOutputArray Then
|
||||
If IsMissing(pvHeaders) Or IsMissing(pvData) Then Call _TraceArguments()
|
||||
pvOutputFormat = "HTML"
|
||||
End If
|
||||
|
||||
Dim sOutputFile As String, oTable As Object
|
||||
Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutput As Boolean, sSuffix As String
|
||||
|
||||
'Find applicable table or query
|
||||
If pvObjectType = acOutputTable Then Set oTable = TableDefs(pvObjectName, True) Else Set oTable = Querydefs(pvObjectName, True)
|
||||
If IsNull(oTable) Then Goto Error_NotFound
|
||||
If pvObjectType = acOutputArray Then
|
||||
Set oTable = Nothing
|
||||
Else
|
||||
'Find applicable table or query
|
||||
If pvObjectType = acOutputTable Then Set oTable = TableDefs(pvObjectName, True) Else Set oTable = Querydefs(pvObjectName, True)
|
||||
If IsNull(oTable) Then Goto Error_NotFound
|
||||
End If
|
||||
|
||||
'Determine format and parameters
|
||||
If pvOutputFormat = "" Then
|
||||
@ -698,7 +709,11 @@ Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutp
|
||||
'Create file
|
||||
Select Case sOutputFormat
|
||||
Case UCase(acFormatHTML), "HTML"
|
||||
bOutput = _OutputToHTML(oTable, sOutputFile, pvTemplateFile)
|
||||
If pvObjectType = acOutputArray Then
|
||||
bOutput = _OutputToHTML(Nothing, pvObjectName, sOutputFile, pvTemplateFile, pvHeaders, pvData)
|
||||
Else
|
||||
bOutput = _OutputToHTML(oTable, pvObjectName, sOutputFile, pvTemplateFile)
|
||||
End If
|
||||
Case UCase(acFormatODS), "ODS"
|
||||
bOutput = _OutputToCalc(oTable, sOutputFile, acFormatODS)
|
||||
Case UCase(acFormatXLS), "XLS"
|
||||
@ -708,7 +723,6 @@ Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutp
|
||||
Case UCase(acFormatTXT), "TXT", "CSV"
|
||||
bOutput = _OutputToCalc(oTable, sOutputFile, acFormatTXT, pvEncoding)
|
||||
End Select
|
||||
oTable.Dispose()
|
||||
|
||||
'Launch application, if requested
|
||||
If bOutput Then
|
||||
@ -720,6 +734,10 @@ Dim sOutputFormat As String, iTemplate As Integer, iOutputFile As Integer, bOutp
|
||||
OutputTo = True
|
||||
|
||||
Exit_Function:
|
||||
If Not IsNull(oTable) Then
|
||||
oTable.Dispose()
|
||||
Set oTable = Nothing
|
||||
End If
|
||||
Utils._ResetCalledSub(cstThisSub)
|
||||
Exit Function
|
||||
Error_NotFound:
|
||||
@ -1225,36 +1243,50 @@ Private Function _OutputClassToHTML(ByVal pvArray As variant) As String
|
||||
End Function ' _OutputClassToHTML V1.4.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _OutputDataToHTML(poTable As Object, piFile As Integer) As Boolean
|
||||
' Write html tags around data found in poTable
|
||||
Private Function _OutputDataToHTML(ByRef pvTable As Variant, ByVal pvName As String, ByVal piFile As Integer _
|
||||
, ByRef Optional pvHeaders As Variant _
|
||||
, ByRef Optional pvData As Variant _
|
||||
) As Boolean
|
||||
' Write html tags around data found in pvTable
|
||||
' Exit when error without execution stop (to avoid file remaining open ...)
|
||||
|
||||
Dim oTableRS As Object, vData() As Variant, i As Integer, j As Integer
|
||||
Dim vFieldsBin() As Variant, iDataType As Integer, iNumRows As Integer, iNumFields As Integer, vDataCell As Variant
|
||||
Dim bDataArray As Boolean, sHeader As String
|
||||
Dim vTrClass() As Variant, vTdClass As Variant, iCountRows As Integer, iLastRow As Integer
|
||||
Const cstMaxRows = 200
|
||||
On Local Error GoTo Error_Function
|
||||
|
||||
bDataArray = IsNull(pvTable)
|
||||
Print #piFile, " <table class=""dbdatatable"">"
|
||||
Print #piFile, " <caption>" & poTable._Name & "</caption>"
|
||||
Print #piFile, " <caption>" & pvName & "</caption>"
|
||||
|
||||
Set oTableRS = poTable.OpenRecordset( , , dbReadOnly)
|
||||
vFieldsBin() = Array()
|
||||
iNumFields = oTableRS.Fields.Count
|
||||
ReDim vFieldsBin(0 To iNumFields - 1)
|
||||
With com.sun.star.sdbc.DataType
|
||||
If bDataArray Then
|
||||
Set oTableRS = Nothing
|
||||
iNumFields = UBound(pvHeaders) + 1
|
||||
ReDim vFieldsBin(0 To iNumFields - 1)
|
||||
For i = 0 To iNumFields - 1
|
||||
iDataType = oTableRS.Fields(i).DataType
|
||||
vFieldsBin(i) = False
|
||||
If iDataType = .BINARY Or iDataType = .VARBINARY Or iDataType = .LONGVARBINARY Or iDataType = .BLOB Or iDataType = .CLOB Then vFieldsBin(i) = True
|
||||
vFieldsBin(i) = False
|
||||
Next i
|
||||
End With
|
||||
Else
|
||||
Set oTableRS = pvTable.OpenRecordset( , , dbReadOnly)
|
||||
iNumFields = oTableRS.Fields.Count
|
||||
ReDim vFieldsBin(0 To iNumFields - 1)
|
||||
With com.sun.star.sdbc.DataType
|
||||
For i = 0 To iNumFields - 1
|
||||
iDataType = oTableRS.Fields(i).DataType
|
||||
vFieldsBin(i) = Utils._IsBinaryType(iDataType)
|
||||
Next i
|
||||
End With
|
||||
End If
|
||||
|
||||
With oTableRS
|
||||
Print #piFile, " <thead>"
|
||||
Print #piFile, " <tr>"
|
||||
For i = 0 To iNumFields - 1
|
||||
Print #piFile, " <th scope=""col"">" & .Fields(i)._Name & "</th>"
|
||||
If bDataArray Then sHeader = pvHeaders(i) Else sHeader = .Fields(i)._Name
|
||||
Print #piFile, " <th scope=""col"">" & sHeader & "</th>"
|
||||
Next i
|
||||
Print #piFile, " </tr>"
|
||||
Print #piFile, " </thead>"
|
||||
@ -1262,13 +1294,21 @@ Const cstMaxRows = 200
|
||||
Print #piFile, " </tfoot>"
|
||||
|
||||
Print #piFile, " <tbody>"
|
||||
.MoveLast
|
||||
iLastRow = .RecordCount
|
||||
.MoveFirst
|
||||
If bDataArray Then
|
||||
iLastRow = UBound(pvData, 2) + 1
|
||||
Else
|
||||
.MoveLast
|
||||
iLastRow = .RecordCount
|
||||
.MoveFirst
|
||||
End If
|
||||
iCountRows = 0
|
||||
Do While Not .EOF()
|
||||
vData() = .GetRows(cstMaxRows)
|
||||
iNumRows = UBound(vData, 2) + 1
|
||||
Do While iCountRows < iLastRow
|
||||
If bDataArray Then
|
||||
iNumRows = iLastRow
|
||||
Else
|
||||
vData() = .GetRows(cstMaxRows)
|
||||
iNumRows = UBound(vData, 2) + 1
|
||||
End If
|
||||
For j = 0 To iNumRows - 1
|
||||
iCountRows = iCountRows + 1
|
||||
vTrClass() = Array()
|
||||
@ -1281,7 +1321,7 @@ Const cstMaxRows = 200
|
||||
If i = 0 Then vTdClass() = _AddArray(vTdClass, "firstcol")
|
||||
If i = iNumFields - 1 Then vTdClass() = _AddArray(vTdClass, "lastcol")
|
||||
If Not vFieldsBin(i) Then
|
||||
vDataCell = vData(i, j)
|
||||
If bDataArray Then vDataCell = pvData(i, j) Else vDataCell = vData(i, j)
|
||||
Select Case VarType(vDataCell)
|
||||
Case vbEmpty, vbNull
|
||||
vTdClass() = _AddArray(vTdClass, "null")
|
||||
@ -1310,7 +1350,7 @@ Const cstMaxRows = 200
|
||||
Next j
|
||||
Loop
|
||||
|
||||
.mClose()
|
||||
If Not bDataArray Then .mClose()
|
||||
End With
|
||||
Set oTableRS = Nothing
|
||||
|
||||
@ -1537,9 +1577,13 @@ Error_Function:
|
||||
End Function ' OutputToCalc V1.4.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function _OutputToHTML(poTable As Object, ByVal psOutputFile As String, ByVal psTemplateFile As String) As Boolean
|
||||
Public Function _OutputToHTML(ByRef pvTable As Variant, ByVal pvName As String, ByVal psOutputFile As String, ByVal psTemplateFile As String _
|
||||
, ByRef Optional pvHeaders As Variant _
|
||||
, ByRef Optional pvData As Variant _
|
||||
) As Boolean
|
||||
' http://www.ehow.com/how_5652706_create-html-template-ms-access.html
|
||||
|
||||
Dim bDataArray As Boolean
|
||||
Dim vMinimalTemplate As Variant, vTemplate As Variant
|
||||
Dim iFile As Integer, i As Integer, sLine As String, lBody As Long
|
||||
Const cstTitle = "<!--Template_Title-->", cstBody = "<!--Template_Body-->"
|
||||
@ -1560,6 +1604,8 @@ Const cstTitleAlt = "<!--AccessTemplate_Title-->", cstBodyAlt =
|
||||
|
||||
vTemplate = _ReadFileIntoArray(psTemplateFile)
|
||||
If LBound(vTemplate) > UBound(vTemplate) Then vTemplate() = vMinimalTemplate()
|
||||
|
||||
bDataArray = IsNull(pvTable)
|
||||
|
||||
' Write output file
|
||||
iFile = FreeFile()
|
||||
@ -1570,12 +1616,16 @@ Const cstTitleAlt = "<!--AccessTemplate_Title-->", cstBodyAlt =
|
||||
sLine = Join(Split(sLine, cstBodyAlt), cstBody)
|
||||
Select Case True
|
||||
Case InStr(sLine, cstTitle) > 0
|
||||
sLine = Join(Split(sLine, cstTitle), poTable._Name)
|
||||
sLine = Join(Split(sLine, cstTitle), pvName)
|
||||
Print #iFile, sLine
|
||||
Case InStr(sLine, cstBody) > 0
|
||||
lBody = InStr(sLine, cstBody)
|
||||
If lBody > 1 Then Print #iFile, Left(sLine, lBody - 1)
|
||||
_OutputDataToHTML(poTable, iFile)
|
||||
If bDataArray Then
|
||||
_OutputDataToHTML(pvTable, pvName, iFile, pvHeaders, pvData)
|
||||
Else
|
||||
_OutputDataToHTML(pvTable, pvName, iFile)
|
||||
End If
|
||||
If Len(sLine) > lBody + Len(cstBody) - 1 Then Print #iFile, Right(sLine, Len(sLine) - lBody + Len(cstBody) + 1)
|
||||
Case Else
|
||||
Print #iFile, sLine
|
||||
|
||||
@ -277,6 +277,7 @@ REM -----------------------------------------------------------------
|
||||
Global Const acOutputTable = 0
|
||||
Global Const acOutputQuery = 1
|
||||
Global Const acOutputForm = 2
|
||||
Global Const acOutputArray = -1
|
||||
|
||||
REM AcEncoding
|
||||
REM -----------------------------------------------------------------
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user