为何Excel无法退出?(文件已经退出但进程还是存在!)急!!!
问题是:
按下下面的代码,能够从Access数据库文件中获取所有的表及数据,写入 Excel文件中.(Excel的Sheet 将按表来重新命名,而 每张表保存对应的 表数据),现在问题是:执行代码后 Excel文件是正常退出(如果设置 visible=true,可以看到它正常的退出),但坚持进程 发现 Excel还是没有退出,这就导致我再次执行该代码的时候出错(创建出来的 Excel文件中 Sheet没有增加);
For i = 0 To UBound(Arr_Select_DB())
'获取 数据路中表个个数
If Arr_Select_DB(i) = True Then
Int_Table_Count = 0
str_Select_Count = str_Select_Count + 1 '选择项个数
Set temCon = New ADODB.Connection
temCon.Open "provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Arr_DB_File_Address(i) & ";Persist Security Info=false"
Set temSet = temCon.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, Empty))
Do Until temSet.EOF '检查 数据中的表
If Left(temSet!table_name, 4) <> "MSys" Then
If temSet!table_name <> "DBInfoHistory" Then
Arr_Tem_TableName(Int_Total_Tab_Count) = temSet!table_name
Else
Arr_Tem_TableName(Int_Total_Tab_Count) = i & "@" & temSet!table_name
End If
'Arr_Tem_TableName_Count(K) = temSet.RecordCount
Int_Total_Tab_Count = Int_Total_Tab_Count + 1
Int_Table_Count = Int_Table_Count + 1
DoEvents
End If
temSet.MoveNext
Loop
Arr_Table_Count(i) = Int_Table_Count
Else
Arr_Table_Count(i) = 0
End If
Next
Arr_Tem_TableName(Int_Total_Tab_Count) = "Summary"
'创建 Excel文件
'Call Load_Operate_Excel(Arr_DB_BackUp_File_Address, Arr_Tem_TableName(), i)
'打开 Excel文件
Set xlApp = CreateObject("Excel.application")
'Set xlApp = New Excel.Application
xlApp.Visible = True '操作不可见
Set xlBook = xlApp.Workbooks.Add() '打开创建号的备份文件
'Set xlBook = xlApp.Workbooks.Open(Arr_DB_BackUp_File_Address) '打开创建号的备份文件
For i = 0 To Int_Total_Tab_Count '创建所有 Sheet
If Len(Arr_Tem_TableName(i)) <> 0 Then
Set xlSheet = ActiveWorkbook.Worksheets.Add '添加新sheet
'MsgBox str_Table_Name(i)
xlSheet.Name = Arr_Tem_TableName(i) '重命名新sheet
Else
Exit For
End If
Next
DoEvents
'写入数据到 Excel中
str_Select_Count_Progress = 0
For i = 0 To UBound(Arr_Select_DB())
If Arr_Select_DB(i) = True Then
str_Select_Count_Progress = str_Select_Count_Progress + 1
DoEvents
txt_Show.Text = txt_Show.Text & Flag_Tab & " " & Arr_DB_File(i) & Flag_Tab & vbCrLf '显示此次操作的
ReDim Arr_Table_Name(Arr_Table_Count(i) - 1)
Main_P.Value = str_Select_Count
lab_Main_P.Caption = Int((str_Select_Count_Progress) / Int_Select_DB * 100) & "%"
lab_Main_P_Count.Caption = (str_Select_Count_Progress) & "/" & Int_Select_DB
Sub_P.Max = Arr_Table_Count(i) '定义该数据库表的数量
For k = 0 To Arr_Table_Count(i) - 1 '获取 数据库中包含有的所有 表 list
Sub_P.Value = k + 1
lab_Sub_P.Caption = Int((k + 1) / Arr_Table_Count(i) * 100) & "%"
If i = 0 Then
Arr_Table_Name(k) = Arr_Tem_TableName(k)
ElseIf i = 1 Then
Arr_Table_Name(k) = Arr_Tem_TableName(k + Arr_Table_Count(0))
ElseIf i = 2 Then
Arr_Table_Name(k) = Arr_Tem_TableName(k + Arr_Table_Count(1) + Arr_Table_Count(0))
End If
ReDim Arr_Tem_TableName_Field_Size(Arr_Table_Count(i) - 1)
ReDim Arr_Tem_TableName_DataCount(Arr_Table_Count(i) - 1)
ReDim Arr_Tem_TableName_DataCount_Info(Arr_Table_Count(i) - 1)
ReDim Arr_Table_Name_DataCount(Arr_Table_Count(i) - 1)
Call Load_Table_Info(Arr_DB_File_Address(i), Arr_Table_Name(k), Arr_Tem_TableName_Field_Size(k), Arr_Tem_TableName_DataCount_Info(k), Arr_Tem_TableName_DataCount(k)) '得到对应的每个表的 字段大小 以及数据量
Set xlSheet = xlBook.Worksheets("Summary") '开始操作 选定的 Sheet-》对应表名
xlSheet.Activate
DoEvents
'str_Save_Tem = str_Save_Tem & Arr_DB_Name(i) & ","
xlSheet.cells(1, 1) = "WYZ@" & str_Code '第 1 行为验证码:@ 文件名 Arr_DB_BackUp_File_Name
xlSheet.cells(2, 1) = "WYZ@" & Arr_DB_BackUp_File_Name '第 2 行为文件名
xlSheet.cells(3, 1) = "Back Up User:" & LogOn_User_IDName '第 3 行为 备份者
xlSheet.cells(4, 1) = "Restore Time:" & "" '第 4 行为 本次恢复时间
xlSheet.cells(5, 1) = "Restore User:" & "" '第 5 行为 本次恢复者
'第 6 行为 空
'第 7+i 行为 数据库 表 字段信息
'第 8+i 行为 数据库 表 数据量信息
txt_Show.Text = txt_Show.Text & Format(k, "00") & ">>Count: <<" & Arr_Tem_TableName_DataCount(k) & " (" & Arr_Table_Name(k) & " Info)" & vbCrLf
lab_Count.Caption = Arr_Tem_TableName_DataCount(k)
If i = 0 Then
xlSheet.cells(7 + k * 3, 1) = Arr_Tem_TableName_Field_Size(k)
xlSheet.cells(8 + k * 3, 1) = Arr_Tem_TableName_DataCount_Info(k)
Else
xlSheet.cells(7 + k * 3 + Arr_Table_Count(i - 1), 1) = Arr_Tem_TableName_Field_Size(k)
xlSheet.cells(8 + k * 3 + Arr_Table_Count(i - 1), 1) = Arr_Tem_TableName_DataCount_Info(k)
End If
Set xlSheet = xlBook.Worksheets(Arr_Table_Name(k)) '开始操作 选定的 Sheet-》对应表名
xlSheet.Activate
DoEvents
'载入数据库 搜索表
WIS_SelectDB_Dest_DataBaseConnectName = Arr_DB_File_Address(i)
If InStr(Arr_Table_Name(k), "@") = 0 Then
WIS_Search_MDB_Str = "Select * from " & Arr_Table_Name(k) '& " where 1=2"
Else
'MsgBox Mid(Arr_Table_Name(K), 3)
WIS_Search_MDB_Str = "Select * from " & Mid(Arr_Table_Name(k), 3) '& " where 1=2"
End If
Set WIS_SelectDB_Dest_Rs = WIS_Select_DB_Connect(WIS_Search_MDB_Str)
DoEvents
xlSheet.cells.CopyFromRecordset WIS_SelectDB_Dest_Rs
DoEvents
Next k
DoEvents
WIS_SelectDB_Dest_Rs.Close
Set WIS_SelectDB_Dest_Rs = Nothing
DoEvents
End If
DoEvents
Next
lab_Count.Caption = "Done"
xlApp.ActiveWorkbook.SaveAs Arr_DB_BackUp_File_Address, , , "1234" '创建有密码的Excel
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
xlApp.ActiveWorkbook.Close
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
Public Sub subKillProcess(ByVal strProcess As String)
Dim strComputer As String
Dim objWMIService As Object
Dim colProcessList
Dim objProcess As Object
On Error Resume Next
strComputer = ". "
Set objWMIService = GetObject( "winmgmts: " _
& "{impersonationLevel=impersonate}!\\ " & strComputer & "\root\cimv2 ")
Set colProcessList = objWMIService.ExecQuery _
( "Select * from Win32_Process Where Name = ' " & strProcess & " ' ")
For Each objProcess In colProcessList
objProcess.Terminate
Next
End Sub
以前也碰到过实在不行就杀死
传过来‘Excel.exe’
杀死进程中的Excel
不过可能误杀其他的excle
Private Sub Command1_Click()
Set xlApp = CreateObject("Excel.application")
xlApp.Visible = False '操作不可见
Set xlBook = xlApp.Workbooks.Add() '打开创建号的备份文件
Set xlSheet = xlApp.ActiveWorkbook.Worksheets.Add '添加新sheet
xlSheet.Name = "tem" '重命名新sheet
xlApp.ActiveWorkbook.SaveAs "C:\1.xls", , , "1234"
xlApp.ActiveWorkbook.Close
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
Set xlApp = CreateObject("Excel.application") '新建了一个 Excel A
Set xlBook = xlApp.Workbooks.Add() '在 Excel A 中创建了一个工作簿
Set xlSheet = ActiveWorkbook.Worksheets.Add '在当前 Excel B 的当前工作簿中添加页
xlApp.ActiveWorkbook.SaveAs Arr_DB_BackUp_File_Address, , , "1234" 'Excel A 的当前工作簿保存文件
[解决办法]
To jhone99:
“画一条线,1美元;知道在哪儿画线,9999美元。”
[解决办法]
xlBook.Close (True)
xlApp.Quit