快速和慢速导入Excel表到ACCESS的区别!
今天有空发两段代码分别为快速和慢速导入,不是专业做这个玩意儿的,纯属爱好者中的菜鸟,不喜勿喷!程序代码:
Public Function ImportExcelS(FileName As String, _ SheetName As String, _ TableName As String, _ k As Double) Dim xlsApp As Excel.Application Dim xlsBook As Excel.Workbook Dim xlsSheet As Excel.Worksheet Dim M, N As Double Dim rng As Range Dim I, J As Double Set xlsApp = CreateObject("Excel.Application") Set xlsBook = xlsApp.Workbooks.Open(FileName) Set xlsSheet = xlsBook.Worksheets(SheetName) Set rng = xlsSheet.UsedRange I = rng.Rows.Count J = rng.Columns.Count If Conn.State <> ADODB.ObjectStateEnum.adStateClosed Then Conn.Close Conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & App.Path & "\datas\Data_Source.mdb" & "';Persist Security Info=False" Conn.Open If rst.State = adStateOpen Then rst.Close rst.Open "SELECT * FROM " & TableName, Conn, adOpenKeyset, adLockOptimistic M = 6 N = 1 For M = k To I rst.AddNew For Each Fn In rst.Fields For N = 1 To J If xlsSheet.Cells(1, N) = Fn.name Then rst.Fields(Fn.name) = xlsSheet.Cells(M, N) Exit For End If Next N Next rst.Update FrmImportData.lblStatus.caption = "Status:" & M & " / " & I Next M Set xlsSheet = Nothing xlsBook.Close Set xlsBook = Nothing xlsApp.Quit Set xlsApp = Nothing End Function ============================================================================================================ Public Function ImportExcelF(FileName As String, SheetName As String, TableName As String, k As Double) Dim xlsApp As Excel.Application Dim xlsBook As Excel.Workbook Dim xlsSheet As Excel.Worksheet Dim Arr(1 To 100) As Double Dim M, N As Double Dim rng As Range Dim I, J, a, b, z As Double Set xlsApp = CreateObject("Excel.Application") Set xlsBook = xlsApp.Workbooks.Open(FileName) Set xlsSheet = xlsBook.Worksheets(SheetName) Set rng = xlsSheet.UsedRange I = rng.Rows.Count J = rng.Columns.Count If Conn.State <> ADODB.ObjectStateEnum.adStateClosed Then Conn.Close Conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & App.Path & "\datas\Data_Source.mdb" & "';Persist Security Info=False" Conn.Open If rst.State = adStateOpen Then rst.Close rst.Open "SELECT * FROM " & TableName, Conn, adOpenKeyset, adLockOptimistic M = 6 N = 1 a = 1 For Each Fn In rst.Fields For N = 1 To J Arr(a) = 0 If xlsSheet.Cells(1, N) = Fn.name Then Arr(a) = N z = a Exit For End If Next N a = a + 1 Next 'MsgBox Arr(1) & "," & Arr(2) & "," & Arr(3) & "," & Arr(4) For M = k To 50 b = 0 rst.AddNew For Each Fn In rst.Fields b = b + 1 If Arr(b) <> 0 Then rst.Fields(Fn.name) = xlsSheet.Cells(M, Arr(b)) End If Next rst.Update FrmImportData.lblStatus.caption = "Status:" & M & " / " & I Next M Set xlsSheet = Nothing xlsBook.Close Set xlsBook = Nothing xlsApp.Quit Set xlsApp = Nothing End Function