VBA基礎四：數據庫鏈接(WPS2019)

Provider=Microsoft.Jet.OLEDB.4.0;
User ID=Admin;
Data Source=G:\20200627\test.mdb;
Mode=Share Deny Write;
Extended Properties="";
Jet OLEDB:System database="";
Jet OLEDB:Registry Path="";
Jet OLEDB:Database Password="";
Jet OLEDB:Engine Type=5;
Jet OLEDB:Database Locking Mode=0;
Jet OLEDB:
Global Partial Bulk Ops=2;
Jet OLEDB:Global Bulk Transactions=1;
Jet OLEDB:New Database Password="";
Jet OLEDB:Create System Database=False;
Jet OLEDB:Encrypt Database=False;
Jet OLEDB:Don't Copy Locale on Compact=False;
Jet OLEDB:Compact Without Replica Repair=False;
Jet OLEDB:SFP=False

 

Sub 把Excel數據插入數據庫中()
'*******************************************
'時間：2013-01-08
'作者：Allen
'功能：把當前工作表的數據增加到在程序文件同一目錄下進銷存表數據庫中
'注意：要在工具/引用中引用microsoft activex date objects x.x
'      其中x.x為版本號，可能會因為你安裝的office的版本不同而不同，本例引用了2.5版
'*******************************************
Dim conn As ADODB.Connection
Dim WN As String
Dim TableName As String
Dim sSql As String
Dim tStr As String
'數據庫名，請自行修改，路徑與當前工作簿在同一目錄
WN = "Staff.mdb"
'數據庫的表名與當前工作表名一致
TableName = ActiveSheet.Name

Set conn = New ADODB.Connection
conn.ConnectionString = "Provider=Microsoft.Jet.Oledb.4.0;" & _
                        "Extended Properties=Excel 8.0;" & _
                        "Data Source= E:\ExcelTest\Employee.xls ;;Extended Properties='Excel 8.0;HDR=YES;IMEX=1' "
conn.Open
If conn.State = adStateOpen Then
    sSql = "Insert Into [;DataBase=" & ActiveWorkbook.Path & "\" & WN & "]." & myWbName & " Select * From [" & ActiveSheet.Name & "$]"
      Cnn.Execute sSql
    MsgBox "成功把數據插入到“" & TableName & "”中！", , "http://Allen.com"
    conn.Close
End If
Set conn = Nothing
End Sub

Sub 利用Excel的VBA將數據bai寫入duAccess()
'定義ADODB 連接Access數據庫
Dim Cnn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim strCon As String
Dim strFileName As String '數據庫文件名
strFileName = InputBox("請輸入文件路徑及文件名：", "Excel傳遞數據至Access", "F:\123.mdb")
'連接字符串，我這里是Access2010,所提供者參數為：Provider=Microsoft.ACE.OLEDB.12.0;
'如果此參數不能使用，根據自己的電腦修改這個字符串
'至於連接至的數據庫名，根據自己的電腦修改，或用一個對話框或其他方式將此值傳遞進程序
strCon = "provider=Microsoft.jet.OLEDB.4.0;" _
& "Data Source=" & strFileName & ";"
Cnn.Open strCon
Rs.ActiveConnection = Cnn
Rs.LockType = adLockOptimistic
Rs.Open "Employee" '假設表為Employee
'定義Excel表中的數據區域以寫入Access
Dim Sht As Worksheet
Dim Rn As Long
Dim Cn As Long
Set Sht = ThisWorkbook.Sheets("Sheet1")
'假設將 Sheet1 表的 2-6行的1、2、3列寫入Access表
For Rn = 2 To 6
Rs.AddNew
Rs!num = Sht.Cells(Rn, 1) 'num,name,department是數據庫中指定表的字段
Rs!Name = Sht.Cells(Rn, 2)
Rs!department = Sht.Cells(Rn, 3)
Rs.Update
Next Rn
MsgBox "完成!"
Rs.Close
Cnn.Close
Set Rs = Nothing
Set Cnn = Nothing
Set Sht = Nothing
End Sub