---------------------------
版本:2022.8.18.1
---------------------------
代码执行出错，错误信息：
System.OutOfMemoryException: Insufficient memory to continue the execution of the program.
at System.RuntimeType.ForwardCallToInvokeMember(String memberName, BindingFlags flags, Object target, Int32[] aWrapperTypes, MessageData& msgData)
at Microsoft.Office.Interop.Excel.Range.get_Value(Object RangeValueDataType)
at UserCode.Test()
---------------------------
OK
---------------------------
我的程序指令如下,通过设置断点确认,出现问题的指令行是:Dim ary = Rg.value,
'Import_WorkOrderStatus 20230911
'文件路径P: \ General documents \ Worktime Data \ Fox Data \ Query \ Work Order Status.xlsx，真正的源数据为 Work Order Status.xlsm
Dim idate1 As Date = Date.Now
Dim t As Integer
Dim gx As Boolean = False
Dim App As New MSExcel.Application
App.DisplayAlerts = False
App.visible = True
Dim TableN As String = "WorkOrderStatus"
If DataTables.Contains(TableN) = False Then
DataTables.Load(TableN)
End If
If DataTables.Contains("Data") = False Then
DataTables.Load("Data")
End If
Tables(TableN).StopRedraw
'DataTables(TableN).DeleteFor("") '删除表内所有数据
Dim fp As String = "P:\General documents\Worktime Data\Fox Data\Query\"
Dim ff = "Work Order Status.xlsx"
Dim fpf As String = fp & ff
If Not filesys.FileExists(fpf) Then Return Nothing
Dim inf As New FileInfo(fpf)
'Dim idate1 As Date = inf.LastWriteTime
Dim cn As String '列名称
Dim i As Integer
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fpf)
Wb.RefreshAll
MessageBox.Show(1)
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
MessageBox.Show(1.1)
Dim Rg As MSExcel.Range = Ws.UsedRange
MessageBox.Show(1.2)
Dim ary = Rg.value
MessageBox.Show(1.3)
Dim cs As Integer = Rg.Columns.Count
output.Show(rg.Rows.Count & "R|C:" & cs)
cs = 26
MessageBox.Show(2)
Dim dic1 As New Dictionary(Of String, DataRow) '存储原始时间(WOStatus),wop==>Row
Dim dic2 As New Dictionary(Of DataRow, Integer) 'Row==>iRw#
Dim wop As String
For Each dr As DataRow In DataTables("WorkOrderStatus").DataRows
wop = dr("WO") & "|" & dr("op")
If Not dic1.ContainsKey(wop) Then
dic1.Add(wop, dr)
End If
Next
MessageBox.Show(3)
For i = 2 To rg.Rows.Count
If ary(i, 2) > "" AndAlso ary(i, 19) > 0 Then
wop = ary(i, 2) & "|" & ary(I, 19)
If dic1.ContainsKey(wop) Then
Dim dr1a As DataRow
dr1a = dic1(wop)
If ary(i, 13) <> dr1a("GoodQty") OrElse ary(i, 15) <> dr1a("BadQty") Then
dic2.Add(dr1a, i) '现有表中存在发生扫描出数量改变时,需要重新写入数据行信息
End If
Else '现有表中不存在数据行,须新增数据行
Dim dr1n As DataRow = DataTables("WorkOrderStatus").AddNew
dic2.add(dr1n, i)
End If
End If
Next
MessageBox.Show(4)
t = dic2.Count
If t = 0 Then
' Return Nothing
gx = True '
Output.Show("无新增/修订数据行")
Else
Dim i1 As Integer = 0
Output.Show(t & "行数据更新")
gx = True
For Each dr2 As DataRow In dic2.Keys
'i1 = i1 + 1
i = dic2(dr2)
For c As Integer = 1 To cs
cn = ary(1, c) '列名
'Output.Show(i1 & ":" & i & "," & cn & ": " & ary(i, c))
dr2(cn) = ary(i, c)
Next
Next
DataTables(TableN).Save
Tables(TableN).Sort = "WO,OP"
gx = True
End if
App.quit
App.displayalerts = True
Dim dr1 As DataRow = DataTables("Data").Find("文件更新_文件名 = '" & ff & "'")
dr1("文件更新_时间") = Date.Now
If gx = True Then
dr1("UpdatinTip") = "成功"
Else
dr1("UpdatinTip") = "更新失败"
End If
dr1.Save
Tables("Data").Sort = "文件更新_时间 Desc"
Tables(TableN).ResumeRedraw
Dim s2 As Date = Date.Now
Dim s3 As TimeSpan = s2 - idate1
Output.Show(idate1 & "-----" & s2 & ",程序Import_WorkOrderStatus经历时间" & s3.TotalSeconds)
恳请帮助解决,谢谢!
加好友 
发短信
Post By：2023/9/19 5:19:00 [只看该作者]
