Excel中的数据倒入Access中，以及Access中的数据倒初到Excel中
Excel中的数据倒入Access中，以及Access中的数据倒初到Excel中
[解决办法]
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 "
这个是第二个代码
Private Sub mDataIn_Click()
Dim fs As New FileSystemObject
Dim strData() As String
Dim blnExt As Boolean
Dim i As Integer
frmTableSel.subGetData strData, blnExt
If blnExt = False Then
For i = 0 To UBound(strData) - 1
If fs.FileExists(App.Path & "\ " & strData(i) & ".xls ") = True Then
gadoCN.Execute "Drop table " & strData(i)
ExportExcelSheetToAccess strData(i), App.Path & "\ " & strData(i) & ".xls ", strData(i), App.Path & "\RentSys.mde "
Call gsubConnectDBF( "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\RentSys.mde;Persist Security Info=False ")
Else
MsgBox strData(i) & "数据源文件不存在！ "
End If
Next i
End If
End Sub
Public 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 "表 " & sAccessTable & "数据导入成功！ ", vbInformation, "数据导入 "
End Sub
Public Sub gsubConnectDBF(sSourceName As String)
Set gadoCN = New ADODB.Connection
gadoCN.ConnectionString = sSourceName
gadoCN.Open
End Sub
