Private Conn1 As New ADODB.Connection
Private Rs1 As New ADODB.Recordset
Private xlApp As Object '定义EXCEL类
Private xlBook1 As Object '定义工件簿类
Private xlSheet1 As Object '定义工作表类
Private Const xlMaximized = -4137
Private Sub CheckExcelCondition()
' StatusBar1.Panels(1).Text = "正在检测办公软件环境……"
On Error GoTo er1
Set xlApp = CreateObject("excel.Application") '创建EXCEL应用类
Set xlBook1 = CreateObject("excel.sheet") '创建EXCEL工作簿
On Error GoTo 0
Exit Sub
er1:
On Error GoTo 0
Set xlApp = CreateObject("et.Application") '创建WPS表应用类
Set xlBook1 = CreateObject("et.workbook")
End Sub
Private Sub Command1_Click()
If Rs1.State = adStateOpen Then Rs1.Close
Rs1.Open "select * from aaa" , Conn1.ConnectionString, 3, 1
If Rs1.RecordCount > 0 Then
If xlApp Is Nothing Then CheckExcelCondition
xlApp.Workbooks.add
Set xlBook1 = xlApp.ActiveWorkbook
Set xlSheet1 = xlBook1.sheets("Sheet1")
For i = 1 To Rs1.Fields.Count
xlSheet1.Cells(1, i) = Rs1.Fields(i - 1).Name
Next
xlSheet1.Cells(2, 1).CopyFromRecordset Rs1
xlApp.Application.WindowState = xlMaximized
xlApp.ScreenUpdating = True
xlApp.Visible = True
Else
MsgBox "未找到符合条件记录！"
End If
End Sub
