Public Function DRExcel(fd As MSHFlexGrid, CD1 As CommonDialog) As Boolean   '导入Excel文件函数  20120621孙广乐

Dim file_name As String
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.worksheet
Dim xlQuery As Excel.QueryTable
Dim r   'r为行数
Dim i, j
On Error GoTo a:
file_name = ""
fnum = FreeFile
CD1.Flags = &H2
With CD1.Flags = cdlOFNHideReadOnly & cdlOFNOverwritePrompt' 设置过滤器.Filter = "xls文档(*.xls)|*.xls|xlsx文档(*.xlsx)|*.xlsx"        '只能导入xls这种文件格式' 指定缺省的过滤器.FilterIndex = 1'.ShowSave
  .ShowOpenfile_name = .filename
End WithIf file_name = "" Then       '判断文件是否存在DRExcel = FalseExit Function
End IfSet xlApp = CreateObject("Excel.Application")
Set xlBook = Nothing
Set xlSheet = Nothing
Set xlBook = xlApp.Workbooks().Add
Set xlSheet = xlBook.Worksheets("sheet1")
'xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open(file_name)
Set xlSheet = xlBook.Worksheets(1)'测列数
j = 1
Do While xlSheet.Cells(1, j) <> ""j = j + 1
Loop
i = 1
Do While xlSheet.Cells(i, 1) <> ""i = i + 1
Loop
If j = 1 Or i = 1 ThenMsgBox "不允许导入空表！"DRExcel = FalseExit Function
End Iffd.Visible = True
fd.rows = i - 1
fd.Cols = j - 1For i = 1 To fd.rowsFor j = 1 To fd.Cols  '列数fd.TextMatrix(i - 1, j - 1) = xlSheet.Cells(i, j)Next j
Next i'xlApp.Application.Visible = True

xlBook.Close
xlApp.Quit   '"交还控制给Excel

fd.ColAlignment(0) = 0 '物品代码
MsgBox "完成导入"
fd.FixedRows = 1
fd.FixedCols = 0
CD1.filename = ""
DRExcel = True
a:
End Function

FGrid1.FixedCols = 0Dim file_name As String
file_name = ""
CD1.Flags = &H2
With CD1.Flags = cdlOFNHideReadOnly & cdlOFNOverwritePrompt' 设置过滤器.Filter = "xls文档(*.xls)|*.xls|xlsx文档(*.xlsx)|*.xlsx"        '只能导入xls这种文件格式' 指定缺省的过滤器.FilterIndex = 1'.ShowSave
  .ShowOpenfile_name = .filename
End WithIf file_name = "" Then       '判断文件是否存在MsgBox ("选择的文件已经不存在了")Exit Sub
End IfDim excelid As Excel.ApplicationSet excelid = New Excel.Applicationexcelid.Workbooks.Open (file_name)excelid.ActiveWindow.SplitRow = 0excelid.ActiveWorkbook.saveexcelid.ActiveWorkbook.Closeexcelid.QuitDim CHART1 As New ADODB.Connection, chart2 As New ADODB.RecordsetCHART1.CursorLocation = adUseClientIf 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'"ElseCHART1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & file_name & ";Extended Properties='Excel 8.0;HDR=Yes'"End IfDim rs As ADODB.RecordsetSet rs = CHART1.OpenSchema(adSchemaTables)Dim ls_name As Stringls_name = rs.Fields(2).Value '取哪个sheet页数据chart2.Open "select * From [" & ls_name & "]", CHART1, adOpenKeyset, adLockOptimisticSet FGrid1.DataSource = chart2Set CHART1 = Nothing
Set chart2 = Nothing