执行完总有个excel.exe的进程
Private Sub Command3_Click() Dim resultValue As Integer Dim sheetName As String Dim result As String Dim sql As String Dim xlapp As New Excel.Application Dim rs As New ADODB.Recordset Dim rsn As New ADODB.Recordset Dim xlbook As Excel.Workbook Dim xlsheet As Excel.Worksheet Dim i As Integer Dim j As Integer Dim n As Integer Dim Y As Integer Dim rows As Integer xlapp.DisplayAlerts = false xlapp.Visible = False Dim cmd As ADODB.Command Dim cmd1 As ADODB.Command' Command1.Enabled = FalseOn Error GoTo HasErr Set cmd = CreateObject("ADODB.Command") Set cmd.ActiveConnection = oConn cmd.CommandText = "{call p_compute(?)}" cmd.Parameters.Append cmd.CreateParameter("@result", adVarChar, adParamInputOutput, 2, "-1") cmd.CommandTimeout = 0 frmMSG.Show frmMSG.Caption = frmMSG.Caption & " —— 数据生成过程中..." cmd.Execute result = cmd.Parameters(0) If result = "0" Then Debug.Print "result = 0" Debug.Print result Command1.Enabled = True Else 'Debug.Print result Command1.Enabled = True MsgBox " 处理过程中出现错误!" End If Set cmd = Nothing 'frmMSG.Caption = frmMSG.Caption & " —— 数据生成完毕,导出到Excel中。" '-------------------- Dim Str_e Str_e = "select * from zhuwenshu order by xuhao" rs.Open Str_e, oConn, adOpenKeyset, adLockReadOnly Set cmd1 = CreateObject("ADODB.Command") Set cmd1.ActiveConnection = oConn oConn.CursorLocation = adUseClient cmd1.CommandType = adCmdStoredProc Y = 2 rows = rs.RecordCount Do While Not rs.EOF If Not WbkExs(rs("workname")) Then Set xlbook = xlapp.Workbooks.Open(app.path & "\test\" & rs("workname")) End If sheetName = rs("sheetname") Set xlsheet = xlbook.Worksheets(sheetName) xlsheet.Activate cmd1.CommandText = "p_getnotnull" cmd1.Parameters(1) = rs("xuhao") Set rsn = cmd1.Execute j = 1 n = 55 'ExportToExcel (Str_e) For i = 3 To rsn.Fields.Count - 1 pShowMsg "正在写【" & rs("workname") & "】中的sheet【" & rs("sheetname") & "】的商品编码" & rsn("商品编码"), "……", CInt(100 * Y / rows) If xlsheet.Cells(n, j + 1).Value <> "" Then n = n + 2 End If If n = 55 Then xlsheet.Cells(n, j + 1).Value = rsn.Fields(i).Name End If xlsheet.Cells(n + 1, j + 1).Select xlapp.Selection.NumberFormatLocal = "@" If xlsheet.Cells(n - 1, 2).Value <> rsn("商品编码").Value Then xlsheet.Cells(n + 1, j + 1).Value = rsn.Fields(i).Value End If xlsheet.Range("B55:BH58").Select xlapp.Selection.Font.Size = 10 '改变字体速度变的有点慢,或许你有更好办法 Next Set rsn = Nothing rs.MoveNext Y = Y + 1 Loop SaveAndCloseAllBook xlapp 'xlapp.Quit 'Set xlapp = Nothing Set rs = Nothing 'oConn.Close Set cmd1 = Nothing frmMSG.Caption = frmMSG.Caption & " —— 写入完毕。" Unload frmMSG MsgBox "写入成功!" Exit SubHasErr: If Err.Number <> cdlCancel Then MsgBox "发生错误。代号:" & Err.Number & Chr(10) & "具体是:" & Err.Description xlbook.Close Set xlbook = Nothing Set xlapp = Nothing xlapp.Quit Set rs = Nothing 'oConn.Close End IfEnd SubSub SaveAndCloseAllBook(app As Excel.Application) Dim ABook As Workbook For Each ABook In app.Workbooks If Not ABook.Saved Then ABook.Save ABook.Close Next app.Quit Set app = NothingEnd Sub