'******************************************************************************************* '功能: 读取Excel文件中的数据,并显示在MSFlexGrid表格中 ' '输入: 无 ' ' '输出: 无 ' ' 作者:冯常军 2003-04-17 AM 8:33 '******************************************************************************************* Private Sub GetExcelValue() Dim errMessage As String Dim iRows As Integer Dim iCols As Integer Dim jOut As Integer Dim kOut As Integer Dim objExcel As Excel.Application Dim objWorkBook As Excel.Workbook Dim objSheet As Excel.Worksheet Dim objRange As Excel.RangeOn Error GoTo err Set objExcel = New Excel.Application Set objWorkBook = objExcel.Workbooks.Open(Me.txtFileName.Text) Set objSheet = objWorkBook.ActiveSheet
'功能: 读取Excel文件中的数据,并显示在MSFlexGrid表格中
'
'输入: 无
'
'
'输出: 无
'
' 作者:冯常军 2003-04-17 AM 8:33
'*******************************************************************************************
Private Sub GetExcelValue()
Dim errMessage As String
Dim iRows As Integer
Dim iCols As Integer
Dim jOut As Integer
Dim kOut As Integer
Dim objExcel As Excel.Application
Dim objWorkBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim objRange As Excel.RangeOn Error GoTo err
Set objExcel = New Excel.Application
Set objWorkBook = objExcel.Workbooks.Open(Me.txtFileName.Text)
Set objSheet = objWorkBook.ActiveSheet
Set objRange = objSheet.UsedRange
iRows = objRange.Rows.count
iCols = objRange.Columns.count
For jOut = 1 To iRows
If Trim$(objSheet.Cells(jOut, 2)) = vbNullString Then Exit For
For kOut = 1 To iCols
With dbgDispaly
.TextMatrix(jOut, kOut - 1) = Trim$(objSheet.Cells(jOut, kOut))
'只需将此句代码改一下即可
End With
Next
dbgDispaly.Rows = dbgDispaly.Rows + 1
prbDaoLu.Value = jOut / iRows * 100
Next
prbDaoLu.Value = 0
objWorkBook.Close
Set objSheet = Nothing
Set objWorkBook = Nothing
Set objExcel = Nothing
err:
errMessage = "第" & "[" & err.Number & "]" & "号错误" & " " & err.Description
If err.Number <> 0 Then MsgBox errMessage, vbCritical, "错误"
End If
End Sub
如何將 Excel 的文件导入 Access文件?
下面我已將程序代码做成模块,只要导入必要之参数即可!此一模块共有四个参数:
1、sSheetName:要导出资料的文件名称 (Sheet name),例如 Sheet1
2、sExcelPath:要导出资料的 Excel 档案路径名称 (Workbook path),例如 C:\book1.xls
3、sAccessTable:要导入的 Access Table 名称,例如 TestTable
4、sAccessDBPath:要导入的 Access 档案路径名称,例如 C:\Test.mdb在声明中加入以下:Private Sub ExportExcelSheetToAccess(sSheetName As String, _
sExcelPath As String, sAccessTable As String, sAccessDBPath As String)
Dim db As Database
Dim rs As Recordset
Set db = OpenDatabase(sExcelPath, True, False, "Excel 5.0")
Call db.Execute("Select * into [;database=" & sAccessDBPath & "]." & _
sAccessTable & " FROM [" & sSheetName & "$]")
MsgBox "Table exported successfully.", vbInformation, "Yams"
End Sub
使用范例如下:將 C:\book1.xls 中的 Sheet1 导入 C:\Test.mdb 成为 TestTableExportExcelSheetToAccess "Sheet1", "C:\book1.xls", "TestTable", "C:\Test.mdb"
不过我现在需要把excel导入access中已经存在的表中
例如要將 C:\book1.xls 中的 Sheet1 导入 C:\Test.mdb 中 TestTable
而TestTable本来已经存在了
不知道该怎么办
之后才能做导入的功能。