'************************************************
'** Function name: ExportTempletToExcel
'** Function function: Export record set to Excel template
'** Particle description:
'** �
'** �
'** �
'** �
'** Function returns:
'** Boolean Type
'** True �
'** False
'** Reference example:
'** �
'************************************************
Private Function ExportTempletToExcel(ByVal strExcelFile As String, _
ByVal strSQL As String, _
ByVal strSheetName As String, _
ByVal adoConn As Object) As Boolean
Dim adoRt As Object
Dim lngRecordCount �
Dim intFieldCount As Integer ' Number of fields
Dim strFields
Dim i As Integer
Dim exlApplication As Object ' Excel Example
Dim exlBook �
Dim exlSheet
On Error GoTo LocalErr
= vbHourglass
'// Create ADO Recordset Object
Set adoRt = CreateObject()
With adoRt
.ActiveConnection = adoConn
.CursorLocation = 3 'adUseClient
.CursorType = 3 'adOpenStatic
.LockType = 1 'adLockReadOnly
.Source = strSQL
.Open
If .EOF And .BOF Then
ExportTempletToExcel = False
Else
'// Get the total number of records, + 1 means there is still a row of field name information.
lngRecordCount = .RecordCount + 1
intFieldCount = . - 1
For i = 0 To intFieldCount
'// Generate field name information (vbTab represents the interval between each cell in Excel)
strFields = strFields & .Fields(i).Name & vbTab
Next
'// Remove the last vbTab tab
strFields = Left$(strFields, Len(strFields) - Len(vbTab))
'// Create an Excel instance
Set exlApplication = CreateObject()
'// Add a workspace
Set exlBook =
'// Set the current workspace to the first worksheet (there will be 3 by default)
Set exlSheet = (1)
'// Change the first worksheet to the specified name
= strSheetName
'// Clear the "Clipboard"
'// Copy the field name to "Clipboard"
strFields
'// Select cell A1
(A1).Select
'// Paste the field name
'// Copy the record set starting from A2
(A2).CopyFromRecordset adoRt
'// Add a named range, which is the required range when importing
strSheetName, = & strSheetName & !$A$1:$ & _
uGetColName(intFieldCount + 1) & $ & lngRecordCount
'//Save Excel file
strExcelFile
'// Exit Excel instance
ExportTempletToExcel = True
End If
'adStateOpen = 1
If .State = 1 Then
.Close
End If
End With
LocalErr:
'*********************************************
'** Release all objects
'*********************************************
Set exlSheet = Nothing
Set exlBook = Nothing
Set exlApplication = Nothing
Set adoRt = Nothing
'*********************************************
If <> 0 Then
End If
= vbDefault
End Function
'// Get the list
Private Function uGetColName(ByVal intNum As Integer) As String
Dim strColNames As String
Dim strReturn As String
'// Usually there are not too many fields, so it is enough to 26*3.
strColNames = A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z, & _
AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO,AP,AQ,AR,AS,AT,AU,AV,AW,AX,AY,AZ, & _
BA,BB,BC,BD,BE,BF,BG,BH,BI,BJ,BK,BL,BM,BN,BO,BP,BQ,BR,BS,BT,BU,BV,BW,BX,BY,BZ
strReturn = Split(strColNames, ,)(intNum - 1)
uGetColName = strReturn
End Function