Use vba to output a record set to an Excel template

Copy codeThe Code is as follows: '*************************************** *********
'** Function name: ExportTempletToExcel
*** Function: outputs a record set to an Excel template.
'** Parameter description:
'** StrExcelFile: the Excel file to be saved
'** The strSQL query statement is the content to export.
'** StrSheetName: Worksheet name
'** AdoConn has opened the database connection
'** Function return:
'** Boolean Type
'** True: the template is exported successfully.
'** False failed
'** Reference instance:
'** Call ExportTempletToExcel (c: \ text.xls, query statement, Worksheet 1, adoConn)
'*************************************** *********
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 As Long number of records
Dim intFieldCount As Integer field count
Dim strFields As String 'all Field Names
Dim I As Integer

Dim exlApplication As Object 'excel instance
Dim exlBook As Object 'excel Workspace
Dim exlSheet As Object 'excel current worksheet to be operated

On Error GoTo LocalErr

Me. MousePointer = vbHourglass

'// Create An ADO record set object
Set adoRt = CreateObject (ADODB. Recordset)

With adoRt
. ActiveConnection = adoConn
. CursorLocation = 3 'aduseclient
. CursorType = 3 'adopenstatic
. LockType = 1 'adlockreadonly
. Source = strSQL
. Open

If. EOF And. BOF Then
ExportTempletToExcel = False
Else
'// Obtain the total number of records. + 1 indicates that there is still a row of field name information.
LngRecordCount =. RecordCount + 1
IntFieldCount =. Fields. Count-1

For I = 0 To intFieldCount
'// Generate field name information (vbTab indicates the interval between cells in Excel)
StrFields = strFields &. Fields (I). Name & vbTab
Next

'// Remove the last vbTab
StrFields = Left $ (strFields, Len (strFields)-Len (vbTab ))

'// Create an Excel instance
Set exlApplication = CreateObject (Excel. Application)
'// Add a workspace
Set exlBook = exlApplication. Workbooks. Add
'// Set the current workspace to the first Worksheet (3 by default)
Set exlSheet = exlBook. Worksheets (1)
'// Change the first worksheet to the specified name
ExlSheet. Name = strSheetName

'// Clear the clipboard"
Clipboard. Clear
'// Copy the field name to the clipboard"
Clipboard. SetText strFields
'// Select cell A1
ExlSheet. Range (A1). Select
'// Paste the field name
ExlSheet. Paste

'// Copy the record set from A2
ExlSheet. Range (A2). CopyFromRecordset adoRt
'// Add a name range to specify the range required during import.
ExlApplication. Names. Add strSheetName, = & strSheetName &! $ A $1: $ &_
UGetColName (intFieldCount + 1) & $ & lngRecordCount
'// Save the Excel file
ExlBook. SaveAs strExcelFile
'// Exit the Excel instance
ExlApplication. Quit

ExportTempletToExcel = True
End If
'Adstateopen = 1
If. State = 1 Then
. Close
End If
End

LocalErr:
'*************************************** ******
'** Release all objects
'*************************************** ******
Set exlSheet = Nothing
Set exlBook = Nothing
Set exlApplication = Nothing
Set adoRt = Nothing
'*************************************** ******

If Err. Number <> 0 Then
Err. Clear
End If

Me. MousePointer = vbDefault
End Function

'// Obtain the column name
Private Function uGetColName (ByVal intNum As Integer) As String
Dim strColNames As String
Dim strReturn As String

'// Usually the number of fields is not too large, so up to 26*3 is enough.
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,, 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