请教关于EXCEL导入ACCESS时用进度条显示的问题

Question

'''现在导入少量的数据时进度条到了一般就停,,,数量多的话则是进度条刚开始很快,但跑完了还是没有导完数据...
Private Sub Command3_Click() 
Call OpenConn 
SQL = "select * from 商品信息" 
rs.Open SQL, cn, 1, 3 
Dim excela_app As Object 
Set excel_App = CreateObject("Excel.application") 
excel_App.Workbooks.Open FileName:=Text1.Text '打开选择好的EXCEL 
i = 2 
Do 
If Len(Trim$(excel_App.Workbooks(1).Worksheets(1).Cells(i, 1))) = 0 Then Exit Do   '如所取数据长度为0则退出 
rs.AddNew 
rs.Fields("商品编号") = Trim$(excel_App.Workbooks(1).Worksheets(1).Cells(i, 1)) 
rs.Fields("商品名称") = Trim$(excel_App.Workbooks(1).Worksheets(1).Cells(i, 2)) 
rs.Fields("规格型号") = Trim$(excel_App.Workbooks(1).Worksheets(1).Cells(i, 3)) 
rs.Fields("库存数量") = Trim$(excel_App.Workbooks(1).Worksheets(1).Cells(i, 4)) 
'------------------------------------------------------------------------------------
rs.Update                                                               
Me.ProgressBar1.Visible = True
i = i + 1
ProgressBar1.Max = rs.RecordCount     '''''这里经过大哥们的指点后修改了,但在导入时进度条还是没有正确显示导入的进度...'请大哥们帮下ProgressBar1.Value = i
DoEvents
Loop
Me.ProgressBar1.Visible = 0                                                
'------------------------------------------------------------------------------------
Call CloseConn
excel_App.ActiveWorkbook.Close False      '不保存关闭Workbook 
MsgBox "共导入" & Format$(i - 2) & "种商品.", vbInformation, "提示:"

Answer 1

做个循环显示的进度条吧Call OpenConn 
SQL = "select * from 商品信息" 
rs.Open SQL, cn, 1, 3 
Dim excela_app As Object 
Set excel_App = CreateObject("Excel.application") 
excel_App.Workbooks.Open FileName:=Text1.Text '打开选择好的EXCEL 
i = 2 
ProgressBar1.Max = 100
ProgressBar1.Value=0
Do 
If Len(Trim$(excel_App.Workbooks(1).Worksheets(1).Cells(i, 1))) = 0 Then Exit Do   '如所取数据长度为0则退出 
rs.AddNew 
rs.Fields("商品编号") = Trim$(excel_App.Workbooks(1).Worksheets(1).Cells(i, 1)) 
rs.Fields("商品名称") = Trim$(excel_App.Workbooks(1).Worksheets(1).Cells(i, 2)) 
rs.Fields("规格型号") = Trim$(excel_App.Workbooks(1).Worksheets(1).Cells(i, 3)) 
rs.Fields("库存数量") = Trim$(excel_App.Workbooks(1).Worksheets(1).Cells(i, 4)) 
'------------------------------------------------------------------------------------
rs.Update                                                               
Me.ProgressBar1.Visible = True
i = i + 1if ProgressBar1.Value=ProgressBar1.max  then ProgressBar1.Value=0
ProgressBar1.Value = ProgressBar1.Value+1DoEvents
Loop
ProgressBar1.Value=ProgressBar1.max
Me.ProgressBar1.Visible = 0                                                
'------------------------------------------------------------------------------------
Call CloseConn
excel_App.ActiveWorkbook.Close False      '不保存关闭Workbook 
MsgBox "共导入" & Format$(i - 2) & "种商品.", vbInformation, "提示:"

Answer 2

为什么做循环显示的呢？  因为你无法得知 总共有多少条记录 自然无法做到MAX了 

Answer 3

在Do循环内加一个Sleep函数（API），这样才能看清楚进度。

Answer 4

UsedRange.Rows.Count
可找到max

Answer 5

EXCEL中 应该有获得总行数的 VBA代码 不过 由于客户的EXCEL千其百变 在记录中有空行的事情常有的    不如做个循环显示方便  大多数客人不会有意见的 

Answer 6

一格一格从EXCEL中读记录,再一条条往ACCESS里面写,逻辑上无疑是正确的,但是效率上也是很低的.
使用以下方法,将可以提高数百倍效率:
1:工程"引用"里面选中ACCESS对象(就和选中EXCEL对象一样)
2:大体代码:
  Dim ACC As New Access.Application
  ACC.OpenCurrentDatabase DBName '数据库全字(*.mdb)
  ACC.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, TableName, XLSName, True, SheetName
'TableName=>数据表名字,XLSName=>Excel文件全名,SheetName=>Excel表的名字
3:要求:预先根据EXCEL的SHEET字段,在MDB中建立好一个空白的数据表(只有字段名,没有记录) 当然,如果为了程序任意性更大,也可以临时获取EXCEL表的字段名,在ACCESS中建立一个同样结构的空表.看你自己需要.4:以上代码就和你在ACCESS中用菜单选择导入一个EXCEL文件是一样的.因此你完全可以在写代码之前先手工导入一个试试,看看速度如何.5:如果成功,给我40分就够了,哈哈

Answer 7

对于有格式的EXCEL处理起来麻烦 还有个方法  先吧数据都到粘贴板里 那样循环数组 肯定更快
Dim SQL As String
Dim Ex As New Excel.Application
Dim ExW As Excel.Workbook
Dim Exs As Excel.Worksheet
Dim Result
Dim Row_l
Dim i As Integer
'打开EXCEL文件
On Error GoTo 0
Set Ex = CreateObject("Excel.Application")
Set ExW = Ex.Workbooks.Open(CommonDialog1.FileName)
Set Exs = ExW.Worksheets("sheet1")
Exs.Columns("A:A").Select
Exs.Copy
Result = Clipboard.GetText
Row_l = Split(Result, vbCrLf)ExW.Close  '关闭工作簿
Set Exs = Nothing  '释放对象,下同
Set ExW = Nothing
Set Ex = NothingFor i = 0 To UBound(Row_l)
    Debug.Print Row_l(i)
Next
ErrHandler:
End Sub

Answer 8

你试试看导一个超过10000条记录的EXCEL就知道差别在哪里了.

Answer 9

请教下"WallesCai"大哥,ACC.OpenCurrentDatabase DBName '数据库全字(*.mdb)'这个是否跟连接数据库的字符串一样呢...俺是在ACCESS中加了密码的,老是搞不定,能否帮下...谢谢....