Dim dlg As new OpenFileDialog
If dlg.ShowDialog = DialogResult.OK Then
    Dim App As New MSExcel.Application
    try
        Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(dlg.FileName)
        Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets("计划表")
        Dim Rg As MSExcel.Range = Ws.UsedRange
        Dim ary = rg.value
       
        Tables("订单").ResumeRedraw()
        Tables("订单").StopRedraw()
        Dim nms() As  String = {"项目","下单日期","MK号","DO号","城市","客户","送货地址","物料代码","数量","体积","重量","承运商","司机","车牌","车数","车型","出车日期","车辆属性","备注","特殊要求","跟车搬运","订单编号"}
        Dim count As Integer = 0
        Dim ls As new List(of Row)
        Dim dic As new Dictionary (Of DataRow, Row)
        systemready = False
        For Each n As Row In Rg.Rows
            If n.IsNull("订单编号") = False
                Dim Filter = "[订单编号] = \'" & n("订单编号") & "\'"
                Dim dr As DataRow = DataTables("订单").sqlFind(filter)
                If dr Is Nothing Then
                    ls.Add(n)
                    count += 1
                Else
                    dic.add(dr, n)
                End If
            End If
        Next
       
       
        For Each n As Row In ls
           
            Dim r As  Row = Tables("订单").AddNew()
            For  m As  Integer = 0 To nms.Length - 1
                If ary(n,m+1) = Nothing Then
                    r(nms(m)) = Nothing
                Else
                    If Tables("订单").Cols(nms(m)).IsDate Then
                        Dim d As Date
                        If Date.TryParse(ary(n,m+1), d)
                            r(nms(m)) = d
                        End If
                    Else
                        r(nms(m)) = ary(n,m+1)
                    End If
                End If
               
            Next
           
        Next
        Tables("订单").ResumeRedraw()
        msgbox("共有 "& count &" 条数据导入" )
       
    catch ex As exception
        msgbox(ex.message)
    finally
        app.quit
    End try
End If

Tables("订单").save

为了更精确导入 我在excel上用公式根据日期生成了(201501020001)这种类型的订单编号 然后把以前的导入代码改为了上面的代码 我想应该是我改错了 For Each n As Row In ls 以前N是int 被我改为row了 可我想保留日期时间的转换   报的错是

不明白你什么意思，原本的代码不需要改啊。

不明白你什么意思，代码就是不用改。

具体问题做例子发上来。

下载信息  [文件大小：   下载次数： ]

点击浏览该文件:导入异常.zip

步凑 菜单选部门 按订单导入 导入订单2是代码没改过的  (请导入工作薄3 ) 不能重复导入已经实现 但不能在订单表中改任何一行不是空行的单元格 改了 这条数据就可以重新导入

那么我就想在excel中的表就生成订单编号再导入 所以我用公式生成了日期格式的编号 然后改了 导入订单的代码 (导入订单是改了的) 虽然代码没报错 但导入时不知道是因为要导入的表中含有公式还是我的代码改错了 报了错

工作薄1是已经生成订单编号的表

Dim dlg As new OpenFileDialog
If dlg.ShowDialog = DialogResult.OK Then
    Dim App As New MSExcel.Application
    try
        Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(dlg.FileName)
        Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets("计划表")
        wb.saved = True
        Dim Rg As MSExcel.Range = Ws.UsedRange
        Dim ary = rg.value
       
        Tables("订单").ResumeRedraw()
        Tables("订单").StopRedraw()
        Dim nms() As  String = {"项目","下单日期","MK号","DO号","城市","客户","送货地址","物料代码","数量","体积","重量","承运商","司机","车牌","车数","车型","出车日期","车辆属性","备注","特殊要求","跟车搬运","订单编号"}
        Dim count As Integer = 0
        Dim ls As new List(of Integer)
        Dim dic As new Dictionary (Of DataRow, Integer)
        systemready = False
        For i As Integer = 2 To Rg.Rows.count
            If ary(i, 22) > "" Then
                Dim Filter = "[订单编号] = \'" & ary(i,22) & "\'"
                Dim dr As DataRow = DataTables("订单").sqlFind(filter)
                If dr Is Nothing Then
                    ls.Add(i)
                    count += 1
                Else
                    dic.add(dr, i)
                End If
            End If
        Next
       
        For Each n As Integer In ls
           
            Dim r As  Row = Tables("订单").AddNew()
            For  m As  Integer = 0 To nms.Length - 1
                If ary(n,m+1) = Nothing Then
                    r(nms(m)) = Nothing
                Else
                    If Tables("订单").Cols(nms(m)).IsDate Then
                        Dim d As Date
                        If Date.TryParse(ary(n,m+1), d)
                            r(nms(m)) = d
                        End If
                    Else
                        r(nms(m)) = ary(n,m+1)
                    End If
                End If
               
            Next
           
        Next
        Tables("订单").ResumeRedraw()
        msgbox("共有 "& count &" 条数据导入" )
        Tables("订单").Save
    catch ex As exception
        msgbox(ex.message)
    finally
        app.quit
    End try
End If

Tables("订单").save

这句代码要去掉

systemready = False

或者在后面写上，匹配使用

systemready = True