用EXECL导出数据

来源：百度知道 编辑：UC知道 时间：2024/05/23 21:55:47
我是用Vb把数据库里数据写入EXECL文件，不过下面有几行代码不明白
，问题就在在代码旁边。慢慢看就看到
Public diskname As String
Public con As New ADODB.Connection
Public Function ExporToExcel(stropen As String)
Dim rs As New ADODB.Recordset
Dim Irowcount As Integer
Dim Icolcount As Integer
Screen.MousePointer = 11
Dim xlApp As New Excel.Application '---创建 Excel 对象
Dim xlBook As Excel.Workbook '---工作簿
Dim xlSheet As Excel.Worksheet '---工作表
Dim xlQuery As Excel.QueryTable '---查询表
With rs
If .State = adStateOpen Then
.Close
End If
.ActiveConnection = con
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Source = stropen
.Open
End With
With rs
If .RecordCount < 1 Then
MsgBox ("没有记录!")
Exit Function

用下面的代码试试，有问题联系我：
Private Sub Command7_Click()
On Error Resume Next
Dim irow As Integer
Dim icol As Integer
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
If MsgBox("您真的要将资料导出到EXCEL中吗？?", vbExclamation + vbYesNo, "警告") = vbYes Then
If PartsRs.RecordCount > 0 Then
PartsRs.MoveFirst
xlSheet.Cells(1, 2) = "SMT配件清单"
xlApp.Range("A1:L1").MergeCells = True
xlApp.Range("A1:L1").HorizontalAlignment = xlCenter

xlSheet.Cells(2, 1) = "编 号"
xlSheet.Cells(2, 2) = "配件料号"
xlSheet.Cells(2, 3) = "配件品名"
xlSheet.Cells(2, 4) = "配件规格"
xlSheet.Cells(2, 5) = "寿命"