| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 3560 人关注过本帖
标题:怎样用VB.NET获取已经打开的Excel对象
只看楼主 加入收藏
黄玉宏
Rank: 2
等 级:论坛游民
帖 子:17
专家分:15
注 册:2007-10-12
结帖率:75%
收藏
 问题点数:0 回复次数:2 
怎样用VB.NET获取已经打开的Excel对象
  可以用GetObject获得首个打开的Excel对象。但我看到说明,它现在用NEW关键字创建类的实例—对象。抛弃了原来的CreatObject函数。那么怎样不用GetObject函数来获取首个打开的Excel对象?
  好像是用捕捉进程什么的?具体这方面我不会,还请各位高手帮忙写个代码,在此先谢谢各位!

  黄玉宏  二○○八年十月二十五日
搜索更多相关主题的帖子: Excel NET 对象 获取 
2008-10-25 17:57
qlong0728
Rank: 3Rank: 3
等 级:新手上路
威 望:8
帖 子:272
专家分:0
注 册:2007-6-15
收藏
得分:0 
给个例子您看看

        Try
            Dim DS As System.Data.DataSet
            Dim MyCommand As System.Data.OleDb.OleDbDataAdapter
            Dim MyConnection As System.Data.OleDb.OleDbConnection
            Dim path, pathsheet, strsql As String
            Dim bing As New BindingSource
            If Len(Text1.Text) = 0 Then
                MsgBox("无此客户代码!", 48, Message_Title)
                TextBox1.Focus()
                Exit Sub
            End If
            If Len(TextBox3.Text) = 0 Then
                MsgBox("Excel表名不能空!", 48, Message_Title)
                TextBox3.Focus()
                Exit Sub
            End If
            If Len(TextBox2.Text) = 0 Then
                MsgBox("文件路径不能空!", 48, Message_Title)
                TextBox2.Focus()
                Exit Sub
            End If
            path = Dir(Trim(TextBox2.Text))
            If path = "" Then
                MsgBox("无此文件!", 48, Message_Title)
                TextBox2.Focus()
                Exit Sub
            End If
            If Strings.Right(UCase(Trim(TextBox2.Text)), 3) <> "XLS" Then
                MsgBox("文件不是Excel文件!", 48, Message_Title)
                TextBox2.Focus()
                Exit Sub
            End If
            pathsheet = Trim(TextBox3.Text) & "$"
            MyConnection = New System.Data.OleDb.OleDbConnection("Provider=Microsoft.Jet.Oledb.4.0;Data Source=" + path + ";Extended Properties=Excel 8.0")
            MyCommand = New System.Data.OleDb.OleDbDataAdapter("select * from [" & pathsheet & "]", MyConnection)
            Label3.Text = "正在打开已经存在的Excel文件,请稍后......"
            Label3.Refresh()
            DS = New System.Data.DataSet()
            MyCommand.Fill(DS)
            Dim i As Integer
            If DS.Tables(0).Rows.Count = 0 Then
                MsgBox("Excel没有数据可导入!", 48, Message_Title)
                Label3.Text = ""
                TextBox2.Focus()
                Exit Sub
            End If
            Dim STRdesc(DS.Tables(0).Rows.Count - 1)
            Dim STbhcb(DS.Tables(0).Rows.Count - 1)
            Dim STbherr As Boolean = False
            DataGridView2.Rows.Clear()
            For i = 0 To DS.Tables(0).Rows.Count - 1
                Label3.Text = "正在检测Excel表格中的不符合规格的数据,请稍后......" & DS.Tables(0).Rows(i)("WP")
                Label3.Refresh()
                If DS.Tables(0).Rows(i)("WP") Is DBNull.Value Then
                    MsgBox("WP列数据有空值,请修正后再导入!", 48, Message_Title)
                    Label3.Text = ""
                    TextBox2.Focus()
                    Exit Sub
                End If
                'If DS.Tables(0).Rows(i)("O/C") Is DBNull.Value Then
                '    MsgBox("O/C列数据有空值,请修正后再导入!", 48, Message_Title)
                '    Label3.Text = ""
                '    TextBox2.Focus()
                '    Exit Sub
                'End If
                'If DS.Tables(0).Rows(i)("Order No") Is DBNull.Value Then
                '    MsgBox("Order No列数据有空值,请修正后再导入!", 48, Message_Title)
                '    Label3.Text = ""
                '    TextBox2.Focus()
                '    Exit Sub
                'End If
                If DS.Tables(0).Rows(i)("Part No") Is DBNull.Value Then
                    MsgBox("Part No列数据有空值,请修正后再导入!", 48, Message_Title)
                    Label3.Text = ""
                    TextBox2.Focus()
                    Exit Sub
                Else
                    Dim dpdata As New DataSet
                    Dim da As New SqlClient.SqlDataAdapter
                    strsql = "select s_desc from s_dp_pn where s_part_no='" & UCase(Trim(DS.Tables(0).Rows(i)("Part No"))) & "'"
                    da.SelectCommand = New SqlClient.SqlCommand(strsql, conn)
                    da.Fill(dpdata, 0)
                    If dpdata.Tables(0).Rows.Count = 0 Then
                        Dim assydata As New DataSet
                        strsql = "select s_desc from s_assy_pn where s_assy_no='" & UCase(Trim(DS.Tables(0).Rows(i)("Part No"))) & "'"
                        da.SelectCommand = New SqlClient.SqlCommand(strsql, conn)
                        da.Fill(assydata, 0)
                        If assydata.Tables(0).Rows.Count = 0 Then
                            Dim ckddata As New DataSet
                            strsql = "select s_desc from s_ckd_pn where s_ckd_no='" & UCase(Trim(DS.Tables(0).Rows(i)("Part No"))) & "'"
                            da.SelectCommand = New SqlClient.SqlCommand(strsql, conn)
                            da.Fill(ckddata, 0)
                            If ckddata.Tables(0).Rows.Count = 0 Then
                                STbherr = True
                                DataGridView2.Rows.Insert(0)
                                DataGridView2.Rows(0).Cells(0).Value = UCase(Trim(DS.Tables(0).Rows(i)("Part No")))
                                'MsgBox("无" & UCase(Trim(DS.Tables(0).Rows(i)("Part No"))) & "产品编号,请维护产品编号后再导入!", 48, Message_Title)
                                'Label3.Text = ""
                                'TextBox2.Focus()
                                'Exit Sub
                            Else
                                STRdesc(i) = ckddata.Tables(0).Rows(0)("s_desc")
                                STbhcb(i) = 3
                            End If
                        Else
                            STRdesc(i) = assydata.Tables(0).Rows(0)("s_desc")
                            STbhcb(i) = 2
                        End If
                    Else
                        STRdesc(i) = dpdata.Tables(0).Rows(0)("s_desc")
                        STbhcb(i) = 1
                    End If
                End If
                If DS.Tables(0).Rows(i)("Order Date") Is DBNull.Value Then
                    MsgBox("Order Date列数据有空值,请修正后再导入!", 48, Message_Title)
                    Label3.Text = ""
                    TextBox2.Focus()
                    Exit Sub
                End If
                If DS.Tables(0).Rows(i)("Order Quantity") Is DBNull.Value Then
                    MsgBox("Order Quantity列数据有空值,请修正后再导入!", 48, Message_Title)
                    Label3.Text = ""
                    TextBox2.Focus()
                    Exit Sub
                End If
                If DS.Tables(0).Rows(i)("Currency") Is DBNull.Value Then
                    MsgBox("Currency列数据有空值,请修正后再导入!", 48, Message_Title)
                    Label3.Text = ""
                    TextBox2.Focus()
                    Exit Sub
                End If
                If DS.Tables(0).Rows(i)("Unit Of Price") Is DBNull.Value Then
                    MsgBox("Unit Of Price列数据有空值,请修正后再导入!", 48, Message_Title)
                    Label3.Text = ""
                    TextBox2.Focus()
                    Exit Sub
                End If
            Next
            If STbherr Then
                Panel6.Visible = True
                Panel3.Enabled = False
                MsgBox("列表中的产品编号没有,请维护产品编号后再导入!", 48, Message_Title)
                Label3.Text = ""
                TextBox2.Focus()
                Exit Sub
            End If
            Dim STRmodel, STRbz, STRph, STRworder As String
            Dim STRdate As Date
            RS_query.Tables(0).Clear()
            For i = 0 To DS.Tables(0).Rows.Count - 1
                Label3.Text = "正在导入数据,请稍后......" & DS.Tables(0).Rows(i)("Part No")
                Label3.Refresh()
                RS_query.Tables(0).Rows.Add()
                RS_query.Tables(0).Rows(i).Item(0) = UCase(Trim(TextBox1.Text))
                RS_query.Tables(0).Rows(i).Item(1) = UCase(Trim(DS.Tables(0).Rows(i)("WP")))
                If DS.Tables(0).Rows(i)("Work Order") Is DBNull.Value Then
                    If DS.Tables(0).Rows(i)("Order No") Is DBNull.Value Then
                        MsgBox("Work Order和Order No列数据不能同时空,请修正后再导入!", 48, Message_Title)
                        Label3.Text = ""
                        TextBox2.Focus()
                        Exit Sub
                    End If
                    STRworder = UCase(Trim(DS.Tables(0).Rows(i)("Order No")))
                Else
                    If DS.Tables(0).Rows(i)("Work Order") = "" Then
                        STRworder = UCase(Trim(DS.Tables(0).Rows(i)("Order No")))
                    Else
                        STRworder = UCase(Trim(DS.Tables(0).Rows(i)("Work Order")))
                    End If
                End If
                RS_query.Tables(0).Rows(i).Item(2) = STRworder
                'RS_query.Tables(0).Rows(i).Item(3) = UCase(Trim(DS.Tables(0).Rows(i)("Work Order")))
                RS_query.Tables(0).Rows(i).Item(3) = UCase(Trim(DS.Tables(0).Rows(i)("Part No")))
                RS_query.Tables(0).Rows(i).Item(4) = STRdesc(i)
                RS_query.Tables(0).Rows(i).Item(5) = Val(DS.Tables(0).Rows(i)("Order Quantity"))
                RS_query.Tables(0).Rows(i).Item(6) = Val(DS.Tables(0).Rows(i)("Unit Of Price"))
                STRdate = Mid(DS.Tables(0).Rows(i)("Order Date"), 1, 4) & "-" & Mid(DS.Tables(0).Rows(i)("Order Date"), 5, 2) & "-" & Mid(DS.Tables(0).Rows(i)("Order Date"), 7, 2)
                RS_query.Tables(0).Rows(i).Item(7) = STRdate
                RS_query.Tables(0).Rows(i).Item(8) = UCase(Trim(DS.Tables(0).Rows(i)("Currency")))
                If DS.Tables(0).Rows(i)("Item Specification") Is DBNull.Value Then
                    STRmodel = ""
                Else
                    STRmodel = Replace(DS.Tables(0).Rows(i)("Item Specification"), "'", "")
                End If
                RS_query.Tables(0).Rows(i).Item(9) = UCase(Trim(STRmodel))

                If DS.Tables(0).Rows(i)("O/C") Is DBNull.Value Then
                    STRph = ""
                Else
                    STRph = DS.Tables(0).Rows(i)("O/C")
                End If
                RS_query.Tables(0).Rows(i).Item(10) = UCase(Trim(STRph))

                If DS.Tables(0).Rows(i)("Description") Is DBNull.Value Then
                    STRbz = ""
                Else
                    STRbz = DS.Tables(0).Rows(i)("Description")
                End If

                RS_query.Tables(0).Rows(i).Item(11) = UCase(Trim(STRbz))

                If STbhcb(i) = 1 Then
                    SQLtile = "update s_dp_pn set s_unit_prince='" & Val(DS.Tables(0).Rows(i)("Unit Of Price")) & "',s_currency='" & UCase(Trim(DS.Tables(0).Rows(i)("Currency"))) & "',s_model='" & UCase(Trim(STRmodel)) & "' " & _
                              "where s_part_no='" & UCase(Trim(DS.Tables(0).Rows(i)("Part No"))) & "'"
                End If
                If STbhcb(i) = 2 Then
                    SQLtile = "update s_assy_pn set s_unit_prince='" & Val(DS.Tables(0).Rows(i)("Unit Of Price")) & "',s_currency='" & UCase(Trim(DS.Tables(0).Rows(i)("Currency"))) & "',s_model='" & UCase(Trim(STRmodel)) & "' " & _
                              "where s_assy_no='" & UCase(Trim(DS.Tables(0).Rows(i)("Part No"))) & "'"
                End If
                If STbhcb(i) = 3 Then
                    SQLtile = "update s_ckd_pn set s_unit_prince='" & Val(DS.Tables(0).Rows(i)("Unit Of Price")) & "',s_currency='" & UCase(Trim(DS.Tables(0).Rows(i)("Currency"))) & "',s_model='" & UCase(Trim(STRmodel)) & "' " & _
                              "where s_ckd_no='" & UCase(Trim(DS.Tables(0).Rows(i)("Part No"))) & "'"
                End If
                Dim CMDbh As New SqlClient.SqlCommand(SQLtile, conn)
                CMDbh.ExecuteNonQuery()

                Dim adddata As New DataSet
                Dim da As New SqlClient.SqlDataAdapter
                strsql = "select s_part_no from s_po where s_po_no='" & STRworder & "' and s_part_no='" & UCase(Trim(DS.Tables(0).Rows(i)("Part No"))) & "' and s_fty_id='" & UCase(Trim(TextBox1.Text)) & "'"
                da.SelectCommand = New SqlClient.SqlCommand(strsql, conn)
                da.Fill(adddata, 0)
                If adddata.Tables(0).Rows.Count = 0 Then
                    SQLtile = "insert into s_po(s_fty_id,s_po_id,s_po_no,s_part_no,s_desc,s_qty,s_unit_price,s_po_date,s_currency,s_model,s_order,s_remarks,s_czr,s_czrq) " & _
                              "values ('" & UCase(Trim(TextBox1.Text)) & "','" & UCase(Trim(DS.Tables(0).Rows(i)("WP"))) & "','" & STRworder & "','" & UCase(Trim(DS.Tables(0).Rows(i)("Part No"))) & "', " & _
                              "'" & STRdesc(i) & "','" & Val(DS.Tables(0).Rows(i)("Order Quantity")) & "','" & Val(DS.Tables(0).Rows(i)("Unit Of Price")) & "','" & STRdate & "','" & UCase(Trim(DS.Tables(0).Rows(i)("Currency"))) & "','" & UCase(Trim(STRmodel)) & "', " & _
                              "'" & STRph & "','" & STRbz & "','" & Username & "','" & Dtdate & "')"
                    'cn.Execute("insert into s_po(s_fty_id,s_po_id,s_po_no,s_part_no,s_desc,s_qty,s_unit_price,s_po_date,s_currency,s_model,s_order,s_remarks,s_czr,s_czrq)" & _
                    '           " values ('" & UCase(Trim(DS.Tables(0).Rows(i)("FTY_ID"))) & "','" & UCase(Trim(DS.Tables(0).Rows(i)("WP"))) & "','" & STRworder & "','" & UCase(Trim(DS.Tables(0).Rows(i)("Part No"))) & "'," & _
                    '           "'" & STRdesc(i) & "','" & Val(DS.Tables(0).Rows(i)("Order Quantity")) & "','" & Val(DS.Tables(0).Rows(i)("Unit Of Price")) & "','" & STRdate & "','" & UCase(Trim(DS.Tables(0).Rows(i)("Currency"))) & "','" & UCase(Trim(STRmodel)) & "'," & _
                    '           "'" & STRph & "','" & STRbz & "','" & Username & "','" & Dtdate & "')")
                Else
                    SQLtile = "update s_po set s_qty='" & Val(DS.Tables(0).Rows(i)("Order Quantity")) & "',s_unit_price='" & Val(DS.Tables(0).Rows(i)("Unit Of Price")) & "',s_czr='" & Username & "', s_czrq='" & Dtdate & "' " & _
                              "where s_po_no='" & STRworder & "' and s_part_no='" & UCase(Trim(DS.Tables(0).Rows(i)("Part No"))) & "' and s_fty_id='" & UCase(Trim(TextBox1.Text)) & "'"
                End If

                Dim CMDsave As New SqlClient.SqlCommand(SQLtile, conn)
                CMDsave.ExecuteNonQuery()

            Next
            Label3.Text = ""
            MsgBox("数据导入完毕!", 48, Message_Title)
        Catch ex As Exception
            MessageBox.Show(ex.ToString, Message_Title, MessageBoxButtons.OK, MessageBoxIcon.Warning)
            Call RSlog(ex.ToString, "Frm_po(Butq_Click)")
            RS_query.Tables(0).Clear()
            Label3.Text = ""
        End Try

程序人员写程序,又拿程序换酒钱。 奔驰宝马贵者趣,公交自行程序员。 不见满街漂亮妹,哪个归得程序员。
2008-10-27 10:17
diedmoon520
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2015-8-8
收藏
得分:0 
我的问题同楼主,但你搞这么复杂,无实际用处
2015-10-23 22:04
快速回复:怎样用VB.NET获取已经打开的Excel对象
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.017252 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved