vb.net读取EXCEL

如果提示“找不到可安装的ISAM”参考我下一个文章


Sub TrnSAAccDataImExcel()
        Dim sDept As String = ""
        Dim sCode As String = ""

        Try
            Dim connectionString As String = ""
            Dim strSQL As String = ""
            Dim BInfoQ_str As String = ""
            Dim rDepartment_id As String = ""
            Dim i As Integer = 0
            Dim j As Integer = 0
            Dim sInsertSQL As String = ""
            Dim BInfoQConn As Status.PowerKernel.Connection = New Status.PowerKernel.Connection
            Dim BInfoQRs As ADODB.Recordset = New ADODB.Recordset
            Dim BInfoQCount As Integer = 0
            Dim sm As String = "0"
            Dim monthisnull As String = ""
            Dim smnum As String = "" '金额
            Dim strBudgetCode As String = "" '科目代码

            'connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" + Me.ViewState("SourcePath") + ";Extended Properties=Excel 8.0;"
            'connectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Me.ViewState("SourcePath") & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
            connectionString = "Provider=Microsoft.Ace.OleDb.12.0;" + "data source=" + Me.ViewState("SourcePath") + ";Extended Properties='Excel 12.0; HDR=Yes; IMEX=1'"
            Dim excelConnection As OleDbConnection = New OleDbConnection(connectionString)
            strSQL = "SELECT * FROM [Sheet1$]"
            excelConnection.Open()
            Dim dbCommand As OleDbCommand = New OleDbCommand(strSQL, excelConnection)
            Dim dataAdapter As OleDbDataAdapter = New OleDbDataAdapter(dbCommand)

            Dim dTable As DataTable = New DataTable()
            dataAdapter.Fill(dTable)
            Dim stryear As String = "" '要导入的文档第一行的年
            Dim strdeptcode As String = "" '要导入的文档第一行的部门代码
            stryear = dTable.Rows(0).Item(0).ToString().Trim() '取到的年份
            strdeptcode = dTable.Rows(0).Item(1).ToString().Trim() ' 取到的部门代码,默认是去0的,再补0够10位
            Dim strdeptcodeLength As Integer = strdeptcode.Length '部门代码的长度
            Dim strendcode As String = "" '存放部门不足10位时候的0的个数
            If strdeptcodeLength < 10 Then
                For i = 0 To 10 - strdeptcodeLength - 1
                    strendcode += "0"
                Next
            End If
            strdeptcode = strendcode & strdeptcode '最终拼接成的10位部门 代码

            '根据部门编码取部门ID
            BInfoQConn = New Status.PowerKernel.Connection
            BInfoQRs = Nothing
            BInfoQCount = 0
            BInfoQ_str = ""
            BInfoQ_str = "select department_id from department where dept_code = '" & strdeptcode & "'; "
            BInfoQRs = BInfoQConn.OpenRs(BInfoQ_str, "2")
            BInfoQCount = 0
            BInfoQCount = BInfoQRs.RecordCount
            If BInfoQCount > 0 Then
                rDepartment_id = BInfoQRs.Fields.Item("department_id").Value
            End If
            '根据部门编码取部门ID 
            '一:如果是当前月以前的月份,则忽略不导入
            '二:如果是当前月以后的数据,先判断数据库里有没有存在,有存在则更新此行数据
            Dim nowyear As String '当前年
            Dim nowmonth As String '当前月
            nowyear = DateTime.Today.Year()
            nowmonth = DateTime.Today.Month()

            i = 0

            

            For i = 0 To dTable.Rows.Count() - 1
                strBudgetCode = dTable.Rows(i).Item(1).ToString().Trim() '取每行第二列的科目代码

                If rDepartment_id <> "" And strBudgetCode <> "" Then
                    Dim linsimonth As String = IIf(nowmonth.ToString().Length = 1, "0" & nowmonth.ToString(), nowmonth.ToString()) '检查临时当前月份是一位数,则在前面补0
                    If dTable.Rows.Count() > 4 Then '先删除当前月及以以后月的预算数据。再循环增加
                        Dim delbudgetsql As String = "delete  from budget where annual='" & nowyear & "' and month>='" & linsimonth & "'  AND Department_id ='" & rDepartment_id & "' AND  Budget_Code  = '" & strBudgetCode & "'  "
                        BInfoQConn.Commit(delbudgetsql, 0)
                    End If
                End If

                
                monthisnull = dTable.Rows(i).Item(1).ToString().Trim() '这里判断科目代码是否为空格,是空格则此行都不存入数据库
                If monthisnull = "" Then '如果此行是空,则不操作
                Else
                    If rDepartment_id <> "" Then
                        If i > 1 Then '从第三行开遍历


                            For j = 2 To 13 '循环每行的12个月的列
                                recordMonth = IIf((j - 1).ToString().Length = 1, "0" & (j - 1).ToString(), (j - 1).ToString()) '检查如果Excel里的月份是一位数,则在前面补0
                                Dim isindb As String = "0"
                                '如果Excel里当前列的月份大于当前月,或者当前列的年份大于当前年,才存入数据库,否则不存入数据库
                                If (stryear = nowyear And Convert.ToInt32(recordMonth) >= Convert.ToInt32(nowmonth)) Or (stryear > nowyear) Then '如果Excel里当前列的月份大于当前月,才存入数据库,否则不存入数据库
                                    isindb = "1"
                                End If
                                If isindb = "1" Then
                                    smnum = dTable.Rows(i).Item(j).ToString().Trim()
                                    'sm = IIf(smnum = "", "0", smnum) '预算金额

                                    If smnum = "" Then
                                    Else '如果金额有填写。才存入数据库
                                        sInsertSQL = sInsertSQL + " if not exists (select * from Budget where Annual='" & stryear & "' and Month='" & recordMonth & "' and Department_id='" & rDepartment_id & "' and Budget_Code='" & strBudgetCode & "' ) begin "
                                        sInsertSQL = sInsertSQL & " Insert Into Budget ( Annual,Month,Department_id,Budget_Code,Budget_Amount,Modify_Employ,Modify_Date ) Values ("
                                        sInsertSQL = sInsertSQL & " '" & stryear & "','" & recordMonth & "','" & rDepartment_id & "','" & strBudgetCode & "'," & smnum & ",'" & Session("Login_Employ_No") & "',getdate() )"
                                        sInsertSQL = sInsertSQL & " end "
                                        sInsertSQL = sInsertSQL & " else "
                                        sInsertSQL = sInsertSQL & " begin "
                                        'sInsertSQL = sInsertSQL & " update Budget SET Budget_Amount='" & sm & "',Modify_Employ='" & Session("Login_Employ_No") & "',Modify_Date=getdate() where Annual='" & stryear & "' and Month='" & recordMonth & "' and Department_id='" & rDepartment_id & "' and Budget_Code='" & strBudgetCode & "' "
                                        sInsertSQL = sInsertSQL & " update Budget SET Budget_Amount=" & smnum & "+(select Budget_Amount  from  budget where Annual='" & stryear & "' and Month='" & recordMonth & "' and Department_id='" & rDepartment_id & "' and Budget_Code='" & strBudgetCode & "' ),Modify_Employ='" & Session("Login_Employ_No") & "',Modify_Date=getdate() where Annual='" & stryear & "' and Month='" & recordMonth & "' and Department_id='" & rDepartment_id & "' and Budget_Code='" & strBudgetCode & "' "
                                        sInsertSQL = sInsertSQL & " end; "
                                    End If


                                    
                                End If

                            Next
                        End If
                    End If
                End If
            Next

            'Response.Write("<script language='javascript' type='text/javascript'>window.open(" & sInsertSQL & "); </script>")
            
            My.Computer.FileSystem.WriteAllText("D:\a1.txt", sInsertSQL, True)

            dTable.Dispose()
            dataAdapter.Dispose()
            dbCommand.Dispose()
            excelConnection.Close()
            excelConnection.Dispose()
            objImportSQL(sInsertSQL) '调用执行批量SQL的方法
            Response.Write("<script>alert('转入资料成功!!');</script>")

        Catch ex As Exception
            Response.Write("<script>alert('无资料转入,'" & ex.Message & "',请重新執行!!');</script>")
        End Try
    End Sub


posted @ 2016-09-27 10:10  离。  阅读(56)  评论(0编辑  收藏  举报