'V20230806 导入Schedule- 看板数据
If User.Type = UserTypeEnum.Developer Then
Dim App As New MSExcel.Application
App.DisplayAlerts = False
App.visible = True
Dim TableN As String = "Schedule"
If DataTables.Contains(TableN) = False Then
DataTables.Load(TableN)
End If
'DataTables(TableN).DeleteFor("") '删除表内所有数据
Dim fp As String = "P:\General documents\Worktime Data\Fox Data\Query\"
Dim ff = "INI Schedule Data.xlsx"
Dim fpf As String = fp & ff
DataTables(TableN).StopRedraw '停止屏幕刷新
If filesys.FileExists(fpf) Then
Dim inf As New FileInfo(fpf)
Dim idate1 As Date = inf.LastWriteTime
idate1 = Date.Now
If DataTables.Contains("Data") = False Then
DataTables.Load("Data")
End If
Dim dt1 As DataTable = DataTables("Data")
Dim dr1 As DataRow = DataTables("Data").Find("文件更新_文件名 = '" & ff & "'")
If dr1 Is Nothing Then
Dim dr1a As DataRow = DataTables("Data").AddNew
dr1a("文件更新_文件名") = ff
dr1a("文件更新_时间") = idate1
Else
dr1("文件更新_时间") = idate1
End If
Dim cn As String '列名称
Dim i As Integer
'SystemReady = False '停止所有其它程序
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
cs = 30
Try
Dim Filter As String
For i = 2 To Rg.Rows.Count
If ary(i, 1) > "" Then '来源存在
If ary(i, 1) > "" AndAlso ary(i, 13) IsNot Nothing Then 'WO,Op均存在的情形下
Filter = "[WO] = '" & ary(i, 1) & "' and [C_Op]= " & ary(i, 13) '根据需要修改'
Dim dr As DataRow = DataTables(TableN).Find(Filter)
If dr Is Nothing Then '新增数据行
Dim ro As Row = Tables(TableN).AddNew
For c As Integer = 1 To cs 'Tables(TableN).Cols.Count - 1
cn = ary(1, c) '列名
ro(cn) = ary(i, c)
Next
Else '已经存在的数据行,须判断是否有修改,简化操作改为直接重写' '
If dr("Pre_Cmpt") <> ary(i, 9) OrElse dr("Plan_StartTime") <> ary(i, 24) OrElse dr("Plan_Endtime") <> ary(i, 25) Then
For c As Integer = 1 To cs 'Tables(TableN).Cols.Count - 1
cn = ary(1, c) '列名
dr(cn) = ary(i, c)
Next
End If
End If
End If
End If
Next
DataTables(TableN).Save
Forms("CellKanban").Controls("Label_Time").Text = "最后更新:" & Format(Date.Now, "G")
'MessageBox.Show("导入成功!", "恭喜!")
Catch ex As exception
msgbox(ex.message)
MessageBox.Show("出现问题的行:" & i & ",对应的列名为:" & cn)
MessageBox.Show("导入失败!", "恭喜!")
End Try
app.quit
End If
1:
DataTables(TableN).ResumeRedraw '恢复屏幕刷新
'MainTable = Tables(TableN)
Tables(TableN).Sort = "WO,C_Op"
SystemReady = True
End If
加好友 
发短信
Post By：2023/8/16 10:27:00 [显示全部帖子]
