标题：Excel导入Foxtable后无法正常关闭
老师,我遇到一个问题,此前运行一直良好,近期突然这个Excel文件定时(15分钟间隔)导入到Foxtable时,发现程序每次运行结束,Excel的进程总关闭不掉, 占用内存越来越大, 运行速度也受到了一定影响, 下面是我的运行结果截图以及程序代码, app.Quit 也是运行正常的,但就不知道为什么无法关闭. 谢谢!
'ImportShippingList'INI Shipping List.xlsx,需要注意的是每月末将下月数据写入(手工更改到Query文件中)
Dim s1 As Date = Date.Now
Dim s2 As Date
Dim s3 As TimeSpan
Dim cg As Boolean = True
Dim Yn As Boolean = False
Dim TableN As String = "INIShippingList"
If Not DataTables.Contains("INIShippingList") Then
Yn = True
DataTables.Load("INIShippingList")
End If
DataTables(TableN).LoadFilter = ""
DataTables(TableN).Load
'DataTables(TableN).StopRedraw '停止屏幕刷新
Dim fp As String = "P:\General documents\Worktime Data\Fox Data\Query\"
Dim ff = "INI Shipping List.xlsx" 'P:\General documents\Worktime Data\Fox Data\Query\
Dim fpf As String = fp & ff
Dim d As New Dictionary(Of String, DataRow) '当前ShippingList表中已经存在WO的行
If filesys.FileExists(fpf) Then
Dim cn As String '列名称
Dim i As Integer
Dim App As New MSExcel.Application
App.DisplayAlerts = False
App.visible = True
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fpf)
Wb.RefreshAll
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim Rg As MSExcel.Range = Ws.UsedRange
Dim ary = Rg.value
Dim cs As Integer = Rg.Columns.Count
Dim c As Integer
Dim Dic_Ex As New Dictionary(Of String, DataRow)
'cs =5
Dim bh As Integer
Dim i1 As Integer = 0
Dim Filter As String
Dim d1s As New Dictionary(Of String, DataRow)
For Each dr As DataRow In DataTables(TableN).DataRows
Dim sowo As String = dr("ISOLineNo") & dr("WO")
If Not Dic_Ex.ContainsKey(SOWO) Then
Dic_Ex.Add(sowo, dr)
Else
'Output.Show("重复行:" & sowo)
dr("Repeatd") = 1
End If
'记录存在工单号的Iso行信息
If dr("WO") > "" Then
If Not d.ContainsKey(dr("ISOLineNo")) Then
d.Add(dr("ISOLineNo"), dr)
End If
Else
If Not d1s.ContainsKey(dr("ISOLineNo")) Then
d1s.Add(dr("ISOLineNo"), dr) '不存在工单的ISO 行
End If
End If
Next
If d1s.Keys.Count > 0 Then '不存在WO 的ISO行, 如果也同时存在ISO和WO的行,则不带WO的需要删除,同时定义为Dic_Ex存在该行
For Each ISO As String In d1s.Keys
Dim dr1s As DataRow = d1s(ISO)
If d.ContainsKey(ISO) Then
If Not Dic_Ex.ContainsKey(ISO) Then
Dic_Ex.Add(ISO, dr1s)
End If
'd1rs.Delete
dr1s("Repeatd") = 1
End If
Next
End If
'MessageBox.Show(1111)
Dim Lst_C As New List(Of String)
For Each dc As DataCol In DataTables(TableN).DataCols
If Not Lst_C.Contains(dc.Name) Then
Lst_C.Add(dc.Name) '字段名集合
End If
Next
Dim bdate As Date = Date.Today.AddDays( - 10)
Dim d2 As New Dictionary(Of String, Integer) '用于记录存在SO+WO的行信息,以便后续删除无效数据行
For i = 2 To Rg.Rows.Count
'Output.Show(i & "," & ary(i, 27))
If ary(i, 27) > "" Then 'ISO#
If isdate(ary(i, 3)) Then '存在交期
If ary(i, 3) >= bdate Then
Dim SOWO As String = ary(i, 27) & ary(i, 7) '此时有可能WO未定义,因此将会导入到Fox中,但当后续如果给了WO,则此行将会被再次导入,这将可能导致行的重复, 因此需要增加程序进行类似
'"如有ISO+WO导入,而表中又有无WO的ISO行存在,则该无WO行须删除", 然后通过在组装工单跟踪表中dISO + + > WO 进行写入
If Not d2.ContainsKey(SOWO) Then
If ary(i, 27) > "" AndAlso ary(i, 7) > "" Then
d2.Add(sowo, i) 'Excel版中的SOWO==>存入row#
End If
End If
If Dic_Ex.ContainsKey(sowo) Then
Dim dr1 As DataRow = Dic_Ex(sowo)
For c = 1 To cs
cn = ary(1, c) '列名
If Lst_C.Contains(cn) Then
'Output.Show("i=" & i & ", " & cn & "=" & ary(i, c))
dr1(cn) = ary(i, c)
End If
Next
Else
Output.Show(i & " New-- " & sowo & "wo:" & ary(i, 7))
Return Nothing
Dim dr1n As DataRow = DataTables(TableN).AddNew
For c = 1 To cs
cn = ary(1, c) '列名
If Lst_C.Contains(cn) Then
'Output.Show("i=" & i & ", " & cn & "=" & ary(i, c))
dr1n(cn) = ary(i, c)
End If
Next
End If
End If
i1 = i1 + 1
End If
End If
Next
App.quit
End If
'进行数据行中存在SO但无WO,与同时存在SO+WO的行进行比较, 删除无效(无WO)数据行
For Each dr1 As DataRow In DataTables(TableN).DataRows
If dr1.IsNull("WO") Then
If d.ContainsKey(dr1("ISOLineNo")) Then
dr1("Repeatd") = 1 '无WO,但该ISOLIneNo行又存在WO的数据行,删除/重复行的信息提示
End If
End If
Next
DataTables(TableN).Save
Dim dt10 As DataTable = DataTables("Data")
Dim dr10 As DataRow = DataTables("Data").Find("文件更新_文件名 = '" & ff & "'")
'DataTables(TableN).ResumeRedraw '停止屏幕刷新
s2 = Date.Now
S3 = s2 - s1
Output.Show(s1 & " -- " & s2 & " 文件 ImportShippingList 刷新经过时间s:" & round2(s3.TotalSeconds, 2))
dr10("SpentTime") = Round2(s3.TotalSeconds, 2)
dr10("文件更新_时间") = Date.Now
dr10.Save
'Functions.Execute("WriteWONo_FromAssemblyTrackIntoShippingList") '在一键刷新计划/导入过程运算
Functions.Execute("DeleteRepeatedRows_InCurrent2Months_In_ShippingList") '进行基于ISO重复项运算,仅对最近2个月的数据进行
If Yn = True Then
DataTables.Unload(TableN)
Else
If Forms("ShippingList").Opened Then
Forms("ShippingList").Controls("Button_OK").PerformClick
End If
End If