Foxtable(狐表)用户栏目专家坐堂 → Excel导入Foxtable后无法正常关闭


  共有503人关注过本帖树形打印复制链接

主题:Excel导入Foxtable后无法正常关闭

帅哥哟,离线,有人找我吗?
creastzh
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:232 积分:1709 威望:0 精华:0 注册:2023/1/11 7:15:00
Excel导入Foxtable后无法正常关闭  发帖心情 Post By:2024/1/25 13:10:00 [只看该作者]

老师,我遇到一个问题,此前运行一直良好,近期突然这个Excel文件定时(15分钟间隔)导入到Foxtable,发现程序每次运行结束,Excel的进程总关闭不掉, 占用内存越来越大, 运行速度也受到了一定影响, 下面是我的运行结果截图以及程序代码, app.Quit 也是运行正常的,但就不知道为什么无法关闭. 谢谢!


图片点击可在新窗口打开查看


[此贴子已经被作者于2024/1/25 13:10:17编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
creastzh
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:232 积分:1709 威望:0 精华:0 注册:2023/1/11 7:15:00
  发帖心情 Post By:2024/1/25 13:12:00 [只看该作者]

'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, 如果也同时存在ISOWO的行,则不带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 

    


 回到顶部
帅哥哟,离线,有人找我吗?
creastzh
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:232 积分:1709 威望:0 精华:0 注册:2023/1/11 7:15:00
  发帖心情 Post By:2024/1/25 13:13:00 [只看该作者]


    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导入,而表中又有无WOISO行存在,则该无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


 回到顶部
帅哥哟,离线,有人找我吗?
creastzh
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:童狐 帖子:232 积分:1709 威望:0 精华:0 注册:2023/1/11 7:15:00
  发帖心情 Post By:2024/1/25 13:13:00 [只看该作者]


想在一个贴里发送程序,但系统提示超出文本字节限制,故分成几段发送, 抱歉

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:106566 积分:541995 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2024/1/25 13:43:00 [只看该作者]

应该是没有执行到退出的代码,放到try里处理

Dim App As New MSExcel.Application
try
    ‘其它处理代码
    App.quit
catch ex As exception
    msgbox(ex.message)
    App.quit
End try

 回到顶部