|
|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
|
quote]以下是引用DC.Direct在2003-11-16 20:50:00的发言：
我从别处只找到个大概，请问谁有具体的实例呢？盼望赐教！
如何將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 成为 TestTable
ExportExcelSheetToAccess "Sheet1", "C:\book1.xls", "TestTable", "C:\Test.mdb"
[/quote]
如下代码可以加在模块里。调用时请用如下格式
ii=ExportExcelSheetToAccess(xl_sheet,xl_name,acc_table)
xl_sheet:表示表的名称,如"sheet1"
xl_name:表示excel的名称，含绝对路径和扩展名，否则程序不会执行。如:"c:\book1.xls"
acc_table：必须为现在的access文件里已经存在的表，且表的字段顺序和内容均需要和xl_sheet一致。否则不能运行或出错。
当 ExportExcelSheetToAccess返回 0代表xlsheet内无内容且不做任何处理。
当 ExportExcelSheetToAccess返回大于0的数值，代表共计处理了多少行记录进入access。
Function ExportExcelSheetToAccess(ByVal xl_sheet As String, ByVal xl_name As String, ByVal acc_table As String) As Integer
Dim xlapp As New Excel.Application
Dim xlbook As Excel.Workbook
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
cnn.Open CurrentProject.Connection
rst.Open acc_table, cnn, adOpenKeyset, adLockOptimistic
Set xlbook = xlapp.Workbooks.Open(xl_name)
If xlbook.Worksheets(xl_sheet).Cells(2, 1) = "" Then '判断是否无内容，设第一行为字段名，从第2行开始自然为数据，如果其为空，自然就没有数据，不处理。
xlbook.Close
xlapp.Quit
rst.Close
Set xlbook = Nothing
Set xlapp = Nothing
Set rst = Nothing
ExportExcelSheetToAccess = 0
Exit Function
End If
t = 2
With xlbook.Worksheets(xl_name)
Do
rst.AddNew
For i = 1 To rst.Fields.Count
rst.Fields(j - 1) = .Cells(t, i)
Next
rst.Update
t = t + 1
Loop Until .Cells(t, 1) = ""
End With
xlbook.Close
xlapp.Quit
set xlbook=nothing
set xlapp =nothing
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
ExportExcelSheetToAccess = t - 1
End Function
[此贴子已经被作者于2003-11-17 12:24:00编辑过] |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2003-11-17 12:22
楼主
