ADO读取EXCEL所有表名

来源：互联网发布：java web微信支付demo 编辑：程序博客网时间：2024/05/29 04:32

        Dim cnFrom     As New ADODB.Connection    'from excel
        Dim cnTo     As New ADODB.Connection      'to sqlserver
        Dim rsFrom     As New ADODB.Recordset
        Dim rsTo     As New ADODB.Recordset
        Dim rsTableName As New ADODB.Recordset

        Dim intTblCnt As Integer
        Dim str1    As String
        Dim intCounts     As Integer
        '连sqlserver
        cnTo.Open "Driver={sql server};server=./hd;uid=sa;pwd=1;database=pms_t"

          '连接Excel
         cnFrom.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                     "Data Source=C:/vb/aa.xls;" & _
                    "Extended Properties=Excel 8.0"
        cnFrom.CursorLocation = adUseClient

        '取excel所有表单名
        Set rsTableName = cnFrom.OpenSchema(adSchemaTables)

        intTblCnt = rsTableName.RecordCount

For t = 1 To intTblCnt
If Len(rsTableName.Fields("TABLE_NAME").Value) <= 4 Then

                      '连接SqlServer
                       str1 = "select * from [" & rsTableName.Fields("TABLE_NAME").Value & "]"
                       Set rsFrom = cnFrom.Execute(str1)

                       Do Until rsFrom.EOF
                       If Not IsNull(rsFrom(0)) Then
                       Debug.Print rsFrom(0), rsFrom(1), rsFrom(2), rsFrom(3), rsFrom(4), rsFrom(5), rsFrom(6), rsFrom(7), rsFrom(8); "" _

                        End If
                         rsFrom.MoveNext
                      Loop
            End If
            rsTableName.MoveNext
        Next
          Set rsTableName = Nothing

          Set rsFrom = Nothing
          Set rsTo = Nothing
          cnFrom.Close
          cnTo.Close
          Set cnFrom = Nothing
          Set cnTo = Nothing

''与特定地址（为示例, $ Sheet 1 [ A1:B10 ]）指定区域
''' rsFrom.Open "select * from [一月$a4:ai37]", cnFrom