由于本人不是用Vb做开发的，现在有一VB程序，在使用过程中，偶尔会出现一些问题，不知道什么原因，特求救各位大师： 程序是通过windows XP pro的计划任务每隔20分钟起动一次，然后它会检查监控的一个目录是否有XML文件，如果有的话，把XML 文件转换成EXCEL，好像隔几个小时就会出错，不固定，出错提示为： An action cannot be completed because a component (Microsoft Excel - book1) is busy. Choose "Switch To" to activate the component and correct the proplem 这个时候，系统里会有一个“Excel.exe”的进程没有结束
只要结束这个进程，再运行程序，又没有问题 源代码如下： Attribute VB_Name = "MdlE2open" '2004-8-25 Option Explicit Dim nCol, nRow As Integer Dim sGet_data As String Dim Inbox_path, Archive_path, db_path As String Dim z3c3_path1, z3c3_path2, z3c3_path3, z4c1_path1, z4c1_path2, z4c1_path3, z4b2_path1, z4b2_path2, z4b2_path3 As String Dim z3c3_TO, z4c1_TO, z4b2_TO, error_TO As String Dim z3c3_CC, z4c1_CC, z4b2_CC As String Dim z3c3_Subject, z4c1_Subject, z4b2_Subject, error_Subject As String Dim z3c3_Text, z4c1_Text, z4b2_Text, error_text As String Dim connection_path, ftp_path As String Dim XMLDoc As MSXML2.DOMDocument40 Private Myinventory As New Clsinventory Private Document_4c1 As New ClsDocument_4c1 Private Document_3c3 As New ClsDocument_3C3 Private Document_4b2 As New ClsDocument_4B2 Dim Rs1 As adodb.Recordset Dim Rs2 As adodb.Recordset Dim Accessconnect As String Dim Addconnect As adodb.Connection
Sub Inventory_4B2(ByRef XML_Node As IXMLDOMNode) On Error GoTo err_handler Dim oXL As Object Dim oWB As Workbook Dim oSheet As excel.Worksheet Dim oRng As excel.Range
Dim xNodeList As IXMLDOMNodeList Dim xNodeList_child As IXMLDOMNodeList Dim xNodeList_descent As IXMLDOMNodeList Dim spart, Mydate As String Dim Filedate As String Dim OnHand As Boolean Dim tqty, tamt As Double Dim i, j As Integer Dim fs, f, f1, ts, ts1, fc Set fs = CreateObject("Scripting.FileSystemObject")
nRow = 1 Set oXL = CreateObject("Excel.Application") ' Get a new workbook. Set oWB = oXL.Workbooks.Add Set oSheet = oWB.Sheets(1) ' Dim nCol, nRow As Integer oSheet.Activate oXL.Visible = True oXL.UserControl = True oSheet.Cells(1, 1) = "Hub Consumption" oSheet.Cells(2, 1) = "Trasmission No :" oSheet.Cells(2, 2) = Document_4b2.DocNO oSheet.Cells(6, 5) = "TXN Type" oSheet.Cells(6, 6) = "Quantity" oSheet.Cells(6, 7) = "PO Qty Bal" oSheet.Cells(6, 8) = "Shipping No" oSheet.Cells(6, 9) = "3PL DO" oSheet.Cells(6, 10) = "RTV Reason"
nRow = 7 Set oRng = oSheet.Range("A6", "J6") With oRng .EntireColumn.AutoFit .Cells.Interior.ColorIndex = 24 .VerticalAlignment = xlVAlignBottom .HorizontalAlignment = xlVAlignCenter End With Set xNodeList = XML_Node.selectNodes("//ShipmentReceiptInformationResource") Set xNodeList_child = XML_Node.selectNodes("//ShipmentReceiptInformationResource[0]//ProductIdentification//ProprietaryProductIdentifier") spart = xNodeList_child.Item(0).Text tqty = 0 tamt = 0 For i = 0 To xNodeList.length - 1 Chr (65 + j) Set xNodeList_child = XML_Node.selectNodes("//ShipmentReceiptInformationResource[" & i & "]//ProductIdentification//ProprietaryProductIdentifier") If spart <> xNodeList_child.Item(0).Text Then oSheet.Cells(nRow, 1) = "Subtotal:(Item " & spart & ")" oSheet.Cells(nRow, 6) = tqty Set oRng = oSheet.Range("A" & nRow & "", "J" & nRow & "") With oRng .Cells.Interior.ColorIndex = 15 End With nRow = nRow + 1 spart = xNodeList_child.Item(0).Text tqty = 0 tamt = 0 End If Set xNodeList_child = XML_Node.selectNodes("//ShipmentReceiptInformationResource[" & i & "]//DateTimeStamp") oSheet.Cells(nRow, 1) = ChangeDatetime(xNodeList_child.Item(0).Text) Set xNodeList_child = XML_Node.selectNodes("//ShipmentReceiptInformationResource[" & i & "]//ProprietaryReferenceIdentifier") oSheet.Cells(nRow, 2) = xNodeList_child.Item(0).Text Set xNodeList_child = XML_Node.selectNodes("//ShipmentReceiptInformationResource[" & i & "]//ProprietaryDocumentIdentifier") oSheet.Cells(nRow, 3) = xNodeList_child.Item(0).Text Set xNodeList_child = XML_Node.selectNodes("//ShipmentReceiptInformationResource[" & i & "]//ProductIdentification//ProprietaryProductIdentifier") oSheet.Cells(nRow, 4) = xNodeList_child.Item(0).Text Set xNodeList_child = XML_Node.selectNodes("//ShipmentReceiptInformationResource[" & i & "]//SeagateProprietaryTransactionType") oSheet.Cells(nRow, 5) = xNodeList_child.Item(0).Text Set xNodeList_child = XML_Node.selectNodes("//ShipmentReceiptInformationResource[" & i & "]//acceptedQuantity") oSheet.Cells(nRow, 6) = xNodeList_child.Item(0).Text Set xNodeList_child = XML_Node.selectNodes("//ShipmentReceiptInformationResource[" & i & "]//SeagateProprietaryPOBalance") oSheet.Cells(nRow, 7) = xNodeList_child.Item(0).Text Set xNodeList_child = XML_Node.selectNodes("//ShipmentReceiptInformationResource[" & i & "]//ProprietaryShipmentTrackingIdentifier") oSheet.Cells(nRow, 8) = xNodeList_child.Item(0).Text Set xNodeList_child = XML_Node.selectNodes("//ShipmentReceiptInformationResource[" & i & "]//SeagateProprietaryDONumber") oSheet.Cells(nRow, 9) = xNodeList_child.Item(0).Text Set xNodeList_child = XML_Node.selectNodes("//ShipmentReceiptInformationResource[" & i & "]//SeagateProprietaryRTVReason") oSheet.Cells(nRow, 10) = xNodeList_child.Item(0).Text tqty = tqty + oSheet.Cells(nRow, 6) nRow = nRow + 1 Mydate = Document_3c3.DocDate Mydate = Replace(Mydate, "-", "") Mydate = Replace(Mydate, ":", "") Mydate = Replace(Mydate, " ", "") Next i oSheet.Cells(nRow, 1) = "Subtotal:(Item " & spart & ")" oSheet.Cells(nRow, 6) = tqty Set oRng = oSheet.Range("A" & nRow & "", "j" & nRow & "") With oRng .Cells.Interior.ColorIndex = 15 End With Mydate = Document_3c3.DocDate Mydate = Replace(Mydate, "-", "") Mydate = Replace(Mydate, ":", "") Mydate = Replace(Mydate, " ", "")
Set oRng = oSheet.Range("A1", "D100") With oRng .VerticalAlignment = xlVAlignBottom .HorizontalAlignment = xlHAlignLeft .EntireColumn.AutoFit End With Set oRng = oSheet.Range("F7", "G100") With oRng .NumberFormat = "#,###.0000" End With
Filedate = Document_4b2.DocDate_1 If Left(Document_4b2.DocNO, 3) = "TTK" Then If fs.FileExists(z4b2_path2 & "\" & Document_4b2.DocNO & "-" & Filedate & ".xls") = False Then oWB.SaveAs z4b2_path2 & "\" & Document_4b2.DocNO & "-" & Filedate & ".xls" Else oWB.Close SaveChanges:=False End If ElseIf Left(Document_4b2.DocNO, 3) = "SZD" Then If fs.FileExists(z4b2_path3 & "\" & Document_4b2.DocNO & "-" & Filedate & ".xls") = False Then oWB.SaveAs z4b2_path3 & "\" & Document_4b2.DocNO & "-" & Filedate & ".xls" Else oWB.Close SaveChanges:=False End If Else If fs.FileExists(z4b2_path1 & "\" & Document_4b2.DocNO & "-" & Filedate & ".xls") = False Then oWB.SaveAs z4b2_path1 & "\" & Document_4b2.DocNO & "-" & Filedate & ".xls" Else oWB.Close SaveChanges:=False End If End If oXL.Quit Set oRng = Nothing Set oSheet = Nothing Set oWB = Nothing Set oXL = Nothing
