如何导入Excel文件

Question

用VB程序如何导入Excel文件，我们公司前一段一直用的导入Txt，现在让导入Excel，请教大家了，多谢

Answer 1

SQL导入Excel:'引用 Microsoft ActiveX Data Objects 2.X Library
Private Sub Command1_Click()
    Dim cn As New ADODB.Connection
    cn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=jtaf;Password=6089280;Initial Catalog=jtaf;Data Source=202.115.166.32"
    cn.CursorLocation = adUseClient
    cn.Open
    cn.Execute ("insert into OpenRowSet('microsoft.jet.oledb.4.0',';database=c:\db2.mdb','select * from dict_content') select * from dict_content")
    cn.Close
    Set cn = Nothing
End Sub

Answer 2

引用Microsoft Scripting Runtime后可以将VB控件里面的内容写入EXCEL，
Private Sub cmdPrintExcel_Click()
    Dim sFileName As String
    Dim xlapp As Object
    Dim xlBook As Object
    Dim xlsheet As Object
    Dim sWIPDailyTemp As String
    
    On Error GoTo errorHandle:
    
    sWIPDailyTemp = App.Path + "\report\CycleTimeReport.xls"      'RCFile
    
    frmSYSWait.Show
    frmSYSWait.proBar.Value = 5
    
    sFileName = App.Path + "\temp\CycleTimeReport.xls"    Set xlapp = CreateObject("Excel.Application")
    Set xlBook = xlapp.Workbooks.Open(sWIPDailyTemp)
    Set xlsheet = xlBook.Worksheets(1)
    
    frmSYSWait.proBar.Value = 25
    
    Call subPrintCycleTimeSummary(xlapp, xlsheet) '列印
    
    xlapp.DisplayAlerts = False    If MsgBox(" 是否要列印？", vbYesNo) = vbYes Then
        xlsheet.PrintOut 'To:=iPage, Copies:=1, Collate:=True
    End If
    
    If MsgBox(" 是否要存档？", vbYesNo) = vbYes Then
        xlBook.SaveAs sFileName
    End If
    
    frmSYSWait.proBar.Value = 85
    
    xlapp.Visible = True
     Set xlapp = Nothing   ' 再释放该引用
     Set xlBook = Nothing
     Set xlsheet = Nothing
     DoEvents
     frmSYSWait.proBar.Value = 95
     Unload frmSYSWait
     Exit Sub
     
errorHandle:     Unload frmSYSWait
     Set xlapp = Nothing   ' 再释放该引用
     Set xlBook = Nothing
     Set xlsheet = Nothing
     MsgBox Err.Number & " " & Err.Description
End Sub
Private Sub subPrintCycleTimeSummary(xlapp As Object, xlsheet As Object)
    Dim iRow As Integer
    Dim iCol As Integer
    Dim strRuncardType As String
    Dim strMark As String
    '列印表头
    xlsheet.Range("A2").Value = "Print Time : " & CStr(Now)
    xlsheet.Range("A3").Value = "Facility：TCP"
    xlsheet.Range("A4").Value = "Query Interval:" & Format(DTPStartDate.Value, "YYYY/MM/DD") & " " & Format(DTPStartTime.Value, "hh:mm") & " ~ " & Format(DTPEndDate.Value, "YYYY/MM/DD") & " " & Format(DTPEndTime.Value, "hh:mm")
    If OptEx.Value = True Then
        xlsheet.Range("A5").Value = "Hold Time:Exclude"
    Else
        xlsheet.Range("A5").Value = "Hold Time:Include"
    End If
'    xlsheet.PageSetup.RightFooter = "制表人：" & ShowUserName
    
    frmSYSWait.proBar.Value = 50    xlsheet.Range("A8").Select
    xlapp.ActiveSheet.Paste
    xlsheet.Range("A1").Select    frmSYSWait.proBar.Value = 75
End Sub

Answer 3

楼上的，你这是导入还是导出啊？我要的是导入Excel

Answer 4

faysky2() 兄：
   能不能把你的思路在说的详细一点，我还是不太明白，多谢了

Answer 5

cn.Execute ("insert into OpenRowSet('microsoft.jet.oledb.4.0',';database=c:\db2.mdb','select * from dict_content') select * from dict_content")
-------------------------------------------------------------
不好意思，上面的写错了，改一下：
 cn.Execute ("insert into OpenRowSet('microsoft.jet.oledb.4.0','Excel 8.0;hdr=yes;database=c:\Test.xls;','select * from [Sheet1$]')(id,name)
select id,name from serv_user")

Answer 6

如果上面的代码运行不了，用下面的代码，已测试通过Private Sub Command1_Click()
    Dim cnSql As New ADODB.Connection, cnExcel As New ADODB.Connection, rsSql As New ADODB.Recordset, rsExcel As New ADODB.Recordset, i%
    
    '打开SQL数据库的连接，具体的需要改一下
    cnSql.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=数据库;Data Source=SQL服务器别名/IP"
    rsSql.CursorLocation = adUseClient
    
    '获取SQL里的Table1的所有记录，准备导出入Excel
    rsSql.Open "select  * from table1", cnSql, adOpenDynamic, adLockReadOnly
   
   '连接C:\Test.xls
    cnExcel.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\test.xls;Extended Properties=Excel 8.0"
    rsExcel.CursorLocation = adUseClient
    '打开Excel的Sheet1表，准备导入数据
    rsExcel.Open "select * from [Sheet1$]", cnExcel, adOpenDynamic, adLockPessimistic
    
    rsSql.MoveFirst
    While Not rsSql.EOF
        rsExcel.AddNew
        For i = 0 To rsSql.Fields.Count - 1
            rsExcel(i) = rsSql(i) '给Excel的记录集赋值
        Next
        rsSql.MoveNext
    Wend
    rsExcel.UpdateBatch '批量更新记录集    Set rsSql = Nothing
    Set rsExcel = Nothing
    cnSql.Close
    Set cnSql = Nothing
    cnExcel.Close
    Set cnExcel = Nothing
End Sub

Answer 7

呵呵，楼上的 faysky2() 你的方法太过时了吧，　　效率不行噢！　要是有几W条数据的话，你自己测试一下看看！呵呵，网上有太多你这样的方法了！　　还是再研究一下更好的办法吧！

Answer 8

EXCEL本身可以导入一定格式的文本文件，
直接调用他的方法啊。技术支持：[email protected]

Answer 9

foreverstar2004(@风一样的城市风一样的男孩@) B话了半天你说个方法啊！！！

Answer 10

faysky2() ( ) 
z支持你的，这个东西我试过，绝对通过，但是导入的是整个EXCEL。

Answer 11

看看从SQL server2000一条条记录导入的方法:Dim xlApp As Variant
Dim xlBook As Variant
Dim xlSheet As VariantCommonDialog1.FileName = "电子表文件名.xls"
CommonDialog1.Filter = "Excel文件 (*.xls)|*.xlt|"
CommonDialog1.ShowSaveSet xlApp = CreateObject("Excel.Application")
xlApp.displayalerts = False
Set xlBook = xlApp.Workbooks.Open(App.Path + "\表格模板.xlt")
xlBook.SaveCopyAs (CommonDialog1.FileName)
xlBook.Close
Set xlBook = xlApp.Workbooks.Open(CommonDialog1.FileName)
Set xlSheet = xlBook.Worksheets(1)xlApp.Visible = False
 For i = 1 To Adodc.Recordset.RecordCount 
    xlSheet.cells(i, 1) = adodc3.Recordset.Fields("字段名1").Value 
    xlSheet.cells(i, 2) = adodc3.Recordset.Fields("字段名2").Value
               .
               .
               . 
   xlSheet.cells(i, n) = adodc3.Recordset.Fields("字段名n").Value
   If Not Adodc.Recordset.EOF Then Adodc.Recordset.MoveNext
Next i(注:加入CommonDialog对象)

Answer 12

看看从SQL server2000一条条记录导入的方法:Dim xlApp As Variant
Dim xlBook As Variant
Dim xlSheet As VariantCommonDialog1.FileName = "电子表文件名.xls"
CommonDialog1.Filter = "Excel文件 (*.xls)|*.xlt|"
CommonDialog1.ShowSaveSet xlApp = CreateObject("Excel.Application")
xlApp.displayalerts = False
Set xlBook = xlApp.Workbooks.Open(App.Path + "\表格模板.xlt")
xlBook.SaveCopyAs (CommonDialog1.FileName)
xlBook.Close
Set xlBook = xlApp.Workbooks.Open(CommonDialog1.FileName)
Set xlSheet = xlBook.Worksheets(1)xlApp.Visible = False
 For i = 1 To Adodc.Recordset.RecordCount 
    xlSheet.cells(i, 1) = adodc3.Recordset.Fields("字段名1").Value 
    xlSheet.cells(i, 2) = adodc3.Recordset.Fields("字段名2").Value
               .
               .
               . 
   xlSheet.cells(i, n) = adodc3.Recordset.Fields("字段名n").Value
   If Not Adodc.Recordset.EOF Then Adodc.Recordset.MoveNext
Next i(注:加入CommonDialog对象)

Answer 13

要高效率，可以使用SQL的“导出数据”功能
在导出过程中，有一个选项（保存DTS包[存为Visual Basic 文件]），选上，在数据导出完成后，它会生成一个类模块，里面有导出的源代码，你使用来完成数据导出

Answer 14

我记得，有一种方案，把Excel的数据copy到剪切板，通过导入剪切板的函数，可以轻松导入，不知道谁有这方面的经验

Answer 15

我的网站上有类似的源码，你可以看看。VB资料->查询“EXCEL”；＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
免费的学习、交流、源码、工具下载网站，欢迎大家访问！
http://www.j2soft.cn/

Answer 16

下面代码已经经过测试（我试了2万多条数据，花费半分钟左右，效率不高）：'引用 Microsoft ActiveX Data Objects 2.X Library
Private Sub Command1_Click()
    Dim cn As New ADODB.Connection
    cn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=jtaf;Password=登陆密码;Initial Catalog=sql里的数据库;Data Source=sql服务器别名或IP"
    cn.CursorLocation = adUseClient
    cn.Open    '导入Excel用下面这句：
    cn.Execute("insert into OpenRowSet('microsoft.jet.oledb.4.0','Excel 8.0;hdr=yes;database=c:\Test.xls;','select * from [Sheet1$]') select top 25000 * from table1")    '导入Access用下面这句：
    'cn.Execute ("insert into OpenRowSet('microsoft.jet.oledb.4.0',';database=c:\Test.mdb','select * from 表1') select top 25000 * from table1")
    cn.Close
    Set cn = Nothing
End Sub    cn.Close
    Set cn = Nothing
End Sub

Answer 17

我记得有个网站介绍说可以通过导入剪切板clipboard的方式方便的导入EXcel，就是先把Excel的内容后台copy到剪切板，再通过剪切板导入,谁知道怎么导入剪切板？请赐教，多谢了