vb中创建Excel,把数据存入Excel
Private Sub ComExport_Click()
Dim xlApp As New Excel.Application
Dim xlBook As New Excel.Workbook '定義Excel工作簿對象
Dim xlSheet As New Excel.Worksheet '定義Excel工作表對象
Dim line As Integer, M As Integer, n As Integer
Dim savepath As String '定義保存路徑
CommonDialog1.CancelError = True '設置cancelError為ture
On Error GoTo errhandler
CommonDialog1.Flags = cdlOFNHideReadOnly
CommonDialog1.FileName = "Report"
CommonDialog1.DefaultExt = ".xls"
CommonDialog1.Filter = "Excel(*.xls)|*.xls|Text(*.txt)|*.txt"
CommonDialog1.FilterIndex = 1
CommonDialog1.Flags = &H2
CommonDialog1.ShowSave
If ERR.Number = cdlCancel Then
Exit Sub
End If
savepath = CommonDialog1.FileName
''######################以下是匯入到excel
Set xlApp = CreateObject("Excel.Application")
' xlApp.Visible = True '根据操作人是否需見到Excel此處可設TRUE 或FALSE
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.add
On Error Resume Next
Set xlSheet = xlBook.Worksheets(1)
If k = 2 Then 'by 機台編號
str_eqid = ""
n = 0
M = 1 '得到的str_eqid 用與excel
For M = 0 To ListSbbh.ListCount - 1
If ListSbbh.Selected(M) = True Then
str_eqid = str_eqid & Trim(ListSbbh.List(M))
If n < ListSbbh.SelCount Then
str_eqid = str_eqid
End If
n = n + 1
End If
Next M
xlSheet.Cells(1, 4) = "EQ Down Top10 Report"
xlSheet.Cells(2, 1) = "Date:"
xlSheet.Cells(2, 2) = Format(DTPickerStart.Value, "yyyy-mm-dd") & " 07:30:00"
xlSheet.Cells(2, 3) = "TO"
xlSheet.Cells(2, 4) = Format(DTPickerEnd.Value + 1, "yyyy-mm-dd") & " 07:30:00"
xlSheet.Cells(3, 1) = "Eqid:"
xlSheet.Cells(3, 2) = str_eqid
xlSheet.Cells(4, 1) = "Bug Poenomenon"
xlSheet.Cells(5, 1) = "Quantity"
rsgzxx.MoveFirst
line = 4
Do While Not rsgzxx.EOF
xlSheet.Cells(4, line).Value = rsgzxx("poenomenon").Value
xlSheet.Cells(5, line).Value = rsgzxx("quantity").Value
line = line + 1
rsgzxx.MoveNext
Loop
End If
xlBook.SaveAs FileName:=savepath, FileFormat:=xlNormal, _
PassWord:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
xlBook.Saved = True '保存到Excel
MsgBox "保存成功！", vbOKOnly, "信息"
'結束EXcel進程
xlApp.Quit '
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
errhandler:
Exit Sub
End Sub