执行完总有个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 = False
On 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 Sub
HasErr:
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 If
End Sub
Sub 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 = Nothing
End Sub
