1.VB高效导入Excel2003和Excel2007文件到MSHFlexGrid控件显示
2.以前也有Excel导入通用功能，但速度有些慢一会把两种实现方式都提供出为参考对比。
一、原通用导入excel文件到MSHFlexGrid控件如下：
Public Function DRExcel(fd As MSHFlexGrid, CD1 As CommonDialog) As Boolean '导入Excel文件函数 20120621孙广乐Dim file_name As StringDim xlApp As New Excel.ApplicationDim xlBook As Excel.WorkbookDim xlSheet As Excel.worksheetDim xlQuery As Excel.QueryTableDim r 'r为行数Dim i, jOn Error GoTo a:file_name = ""fnum = FreeFileCD1.Flags = &H2With CD1 .Flags = cdlOFNHideReadOnly & cdlOFNOverwritePrompt ' 设置过滤器 .Filter = "xls文档(*.xls)|*.xls|xlsx文档(*.xlsx)|*.xlsx" '只能导入xls这种文件格式 ' 指定缺省的过滤器 .FilterIndex = 1 '.ShowSave .ShowOpen file_name = .filenameEnd WithIf file_name = "" Then '判断文件是否存在 DRExcel = False Exit FunctionEnd If Set xlApp = CreateObject("Excel.Application")Set xlBook = NothingSet xlSheet = NothingSet xlBook = xlApp.Workbooks().AddSet xlSheet = xlBook.Worksheets("sheet1")'xlApp.Visible = TrueSet xlBook = xlApp.Workbooks.Open(file_name)Set xlSheet = xlBook.Worksheets(1) '测列数j = 1Do While xlSheet.Cells(1, j) <> "" j = j + 1Loopi = 1Do While xlSheet.Cells(i, 1) <> "" i = i + 1LoopIf j = 1 Or i = 1 Then MsgBox "不允许导入空表！" DRExcel = False Exit FunctionEnd Iffd.Visible = Truefd.rows = i - 1fd.Cols = j - 1 For i = 1 To fd.rows For j = 1 To fd.Cols '列数 fd.TextMatrix(i - 1, j - 1) = xlSheet.Cells(i, j) Next jNext i 'xlApp.Application.Visible = TruexlBook.ClosexlApp.Quit '"交还控制给Excelfd.ColAlignment(0) = 0 '物品代码MsgBox "完成导入"fd.FixedRows = 1fd.FixedCols = 0CD1.filename = ""DRExcel = Truea:End Function 二、新方法，高效把excel文件导入到MSHFlexGrid控件。这个非常高效。如下：
FGrid1.FixedCols = 0Dim file_name As Stringfile_name = ""CD1.Flags = &H2With CD1 .Flags = cdlOFNHideReadOnly & cdlOFNOverwritePrompt ' 设置过滤器 .Filter = "xls文档(*.xls)|*.xls|xlsx文档(*.xlsx)|*.xlsx" '只能导入xls这种文件格式 ' 指定缺省的过滤器 .FilterIndex = 1 '.ShowSave .ShowOpen file_name = .filenameEnd WithIf file_name = "" Then '判断文件是否存在 MsgBox ("选择的文件已经不存在了") Exit SubEnd IfDim excelid As Excel.Application Set excelid = New Excel.Application excelid.Workbooks.Open (file_name) excelid.ActiveWindow.SplitRow = 0 excelid.ActiveWorkbook.save excelid.ActiveWorkbook.Close excelid.QuitDim CHART1 As New ADODB.Connection, chart2 As New ADODB.Recordset CHART1.CursorLocation = adUseClient If Right(file_name, 5) = ".xlsx" Then 'excel2007版本以上 CHART1.Open "Provider=Microsoft.ACE.OLEDB.12.0;Persist Security Info=False;Data Source=" & file_name & ";Extended Properties='Excel 12.0;HDR=Yes'" Else CHART1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & file_name & ";Extended Properties='Excel 8.0;HDR=Yes'" End If Dim rs As ADODB.Recordset Set rs = CHART1.OpenSchema(adSchemaTables) Dim ls_name As String ls_name = rs.Fields(2).Value '取哪个sheet页数据 chart2.Open "select * From [" & ls_name & "]", CHART1, adOpenKeyset, adLockOptimistic Set FGrid1.DataSource = chart2Set CHART1 = NothingSet chart2 = Nothing 作者：王春天 2013.11.14 地址：