以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  Exception from HRESULT: 0x800A03EC 报错  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=190109)
--  作者：creastzh
--  发布时间：2024/1/17 12:45:00
--  Exception from HRESULT: 0x800A03EC 报错
老师, 今日不知道怎么回事,我此前编制的程序运行期间不断报错,报错信息如下:

.NET Framework 版本：4.0.30319.42000
Foxtable 版本：2022.8.18.1
错误所在事件：自定义函数,Import_WeeklyMachining_Schedule
详细错误信息：
Exception has been thrown by the target of an invocation.
Exception from HRESULT: 0x800A03EC

检查程序应该没有异常, 程序清单如下:

\'Import_WeeklyMachining_Schedule 导入 生产计划 Import_WeeklyMachineSchedule V2 通过字典
\'源数据"P:\\PMS\\Weekly producion Schedule\\Weekly production Schedule.xlsm"
Dim TableN As String = "WeeklyMachineSchedule"
Dim yn As Integer
If Not DataTables.Contains(TableN) Then
    DataTables.Load(tablen)
    yn = 1
End if
DataTables(TableN).LoadFilter = "" \' "Process_Completed = false"
DataTables(TableN).Load
\'DataTables(TableN).DeleteFor("WO not like \'%WO\'")

Dim fp As String = "P:\\General documents\\Worktime Data\\Fox Data\\Query\\"
Dim ff = "Weekly Machine Schdule.xlsx"
Dim fpf As String = fp & ff

Dim cg As Boolean = True
Dim s1 As Date 
Dim s2 As Date 
Dim s3 As TimeSpan

If filesys.FileExists(fpf) Then
    Tables(TableN).StopRedraw \'停止屏幕刷新
    
    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)
    s1 = Date.Now
    Wb.RefreshAll
    Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
    Dim Rs As Integer = Ws.Range("A15000").End(MSExcel.XlDirection.xlup).Row
    Dim Cs As Integer = 50
    
    Dim Rg As MSExcel.Range = Ws.Range("A1")
    Rg = Rg.Resize(Rs, cs)
    \'Dim cs As Integer = Rg.Columns.Count
    Dim ary = Rg.value
    Dim c As Integer 
    
    Dim bh As Boolean
    
    Dim Dic_Ext As New Dictionary(Of DataRow, Integer)
    Dim Dic_New As New Dictionary(Of DataRow, Integer)
    
    SystemReady = False \'停止所有其它程序 
    Dim i1 As Integer = 0
    Dim Filter As String
    
    Dim d1 As New Dictionary(Of String, DataRow)
    \'预设WOp 入字典
    For Each dr1 As DataRow In DataTables("WeeklyMachineSchedule").DataRows
        Dim wop As String = dr1("WO") & dr1("OP")
        If Not d1.ContainsKey(wop) Then
            d1.add(wop, dr1)
        Else
            dr1.Delete
        End If 
    Next
    
    Dim zwo As String
    For i = 2 To Rs 
        \'If ARY(i, 5) = "IWO89801/1" Then Output.Show("i=" & i & "; op:" & ary(i, 35) & "  Filter:=" & "[WO] = \'" & ary(i, 5) & "\' and [OP] = " & ary(i, 35))
        \'Filter = "[WO] = \'" & ary(i, 5) & "\' and [OP] = " & ary(i, 35) \'wop    
        \'Dim dr As DataRow = DataTables(TableN).Find(Filter)
        Dim wop As String = ary(i, 5) & ary(i, 35)
        If Not d1.ContainsKey(wop) Then
            Dim dr As DataRow = DataTables("WeeklyMachineSchedule").AddNew  \'新增数据行    
            i1 = i1 + 1
            Dic_New.Add(dr, i)
        Else \'已经存在的数据行,须判断是否有修改,简化操作改为直接重写  
            bh = False \'初始值
            Dim dr As DataRow = d1(wop)
            For c = 1 To cs\' 
                cn = ary(1, c) \'列名
                If dr(cn) <> ary(i, c) Then
                    bh = True
                    Exit For
                End If 
            Next
            If bh = True Then
                If Dic_Ext.ContainsKey(dr) = False Then \'是否存在键
                    Dic_Ext.Add(dr, i)
                    i1 = i1 + 1
                End If
            End If
        End If
        If InStr(ary(i, 5), "Z") > 0 Then
            If zwo = "" Then
                zwo = ary(i, 5)
            Else
                zwo = zwo & "\',\'" & ary(i, 5)
            End If 
        End If 
    Next
    If Dic_New.Count > 0 Then 
        For Each dr As DataRow In Dic_New.Keys
            i = Dic_New(dr)
            For c = 1 To cs
                cn = ary(1, c)
                If cn = "RequiredHours" OrElse cn = "Delay_Days" Then
                    dr(cn) = Round2(ary(i, c), 2)
                ElseIf cn = "RM_RequiredQty" Then
                    dr(cn) = Round2(ary(i, c), 1)
                Else 
                    dr(cn) = ary(i, c)
                End If
            Next
            dr("TaskDate") = Date.Today
        Next 
    End If
    If Dic_Ext.Count > 0 Then
        For Each dr1a As DataRow In Dic_Ext.Keys
            i = Dic_Ext(dr1a)
            For c = 1 To cs
                cn = ary(1, c)
                If cn = "RequiredHours" OrElse cn = "Delay_Days" Then
                    dr1a(cn) = Round2(ary(i, c), 2)
                ElseIf cn = "RM_RequiredQty" Then
                    dr1a(cn) = Round2(ary(i, c), 1)
                Else 
                    dr1a(cn) = ary(i, c)
                End If
            Next
        Next
    End If
    
    \'删除不再存在的Z工单
    If zwo > "" Then
        zwo = "(\'" & zwo & "\')"
        DataTables("WeeklyMachineSchedule").DeleteFor("wo like \'Z%\' and WO not in " & zwo)
    End If 
    SystemReady = True
    App.quit
End If

Dim dt1 As DataTable = DataTables("Data") 
Dim dr1c As DataRow = DataTables("Data").Find("文件更新_文件名 = \'" & ff & "\'")

Tables(TableN).ResumeRedraw \'屏幕恢复刷新
Tables(TableN).Sort = "PartNumber"
Tables("Data").Sort = "文件更新_时间 Desc"
s2 = Date.Now
s3 = s2 - s1
Output.Show(s1 & " -- " & s2 & " Import_WeeklyMachining_Schedule 刷新 总计经过时间s:" & s3.TotalSeconds)

dr1c("SpentTime") = Round2(s3.TotalSeconds, 2)
dr1c("文件更新_文件名") = ff
dr1c("文件更新_时间") = Date.Now
dr1c.Save

DataTables(TableN).Save
If yn = 1 Then DataTables.Unload(TableN)
[此贴子已经被作者于2024/1/17 12:51:25编辑过]
--  作者：有点蓝
--  发布时间：2024/1/17 13:26:00
--  
这种应该是execl文档进程没有全部关闭导致的错误。把vba的代码都放入try里面，保证vba可以正常退出，类似：

Dim App As New MSExcel.Application

try
 Dim Wb As MSExcel.Workbook = App.WorkBooks.open("d:\\test.xls")
……各种vba的处理
    App.Quit
Catch ex As Exception
    MessageBox.Show(ex.message)
    App.Quit
End try
--  作者：creastzh
--  发布时间：2024/1/17 16:31:00
--  
按您的方式,运行正常了, 谢谢!