我正在使用一個舊的宏，它將定義的范圍從 Excel 發送到 MS Access 資料庫，并希望對其進行調整以發送到 SQL Server 資料庫。
舊代碼（效果很好，我不是作者）：
'ExportAccess
Dim db As DAO.Database
Dim Rst As DAO.Recordset
Dim localMDB As String 'this is the address of the access mdb, removed from this snippit
sht = ActiveCell.Worksheet.Name
With Worksheets(sht)
.Range("L1:A" & .Range("A65536").End(xlUp).Row).Name = "Range"
End With
Set db = OpenDatabase(ActiveWorkbook.FullName, False, False, "excel 8.0")
db.Execute "INSERT INTO myTable IN '" & localMDB & "' SELECT * FROM [Range]", dbFailOnError
我的修改嘗試：
Dim db As DAO.Database 'sql database
Dim rs As DAO.Recordset
Dim bd As DAO.Database 'excel sheet?
Dim Rst As DAO.Recordset
Set db = OpenDatabase("myDatabase", dbDriverNoPrompt, False, "ODBC;DATABASE=DB_Backup;DSN=myDatabase")
sht = ActiveCell.Worksheet.Name
With Worksheets(sht)
.Range("B1:A" & .Range("A65536").End(xlUp).Row).Name = "Range"
End With
db.Execute "INSERT INTO myTable SELECT * FROM [Range]", dbFailOnError
當我運行我的嘗試時，它給出了我的“范圍”沒有定義的錯誤。任何幫助將不勝感激，謝謝！
uj5u.com熱心網友回復：
第一個代碼塊成功運行的原因是您連接到可以查詢 Access 資料庫表、Excel 作業簿甚至 CSV 文本檔案的 Microsoft Access Jet/ACE 引擎。請注意如何db直接設定為 Excel 作業簿，以及如何將附加查詢從外部連接到 Access 資料庫。僅 Jet/ACE 引擎支持此語法。
但是，在第二個代碼塊中，您連接的是外部資料庫，即 SQL Server，而不是 Jet/ACE 引擎。因此，不支持類似的語法。具體來說，如錯誤所示，[Range]不存在，因為您沒有連接到作業簿。您將需要在 VBA 中指定范圍內的所有單元格資料以進行適當的資料遷移。不要將 SQL Server 與 MS Office 混為一談，即使它們是同一家公司的產品。
考慮使用 ADO（而不是 DAO）對值進行引數化。確保在附加 SQL 查詢中顯式命名列。雖然您的實際范圍不確定，但下面會回圈范圍的第一列并用于.Offset遍歷當前行中的列。調整 SQL、范圍限制、引數和型別以與實際資料保持一致。
Sub SQLServerAppend()
' ADD REFERENCE FOR Microsoft ActiveX Data Objects #.# Library
Dim con As ADODB.Connection, cmd As ADODB.Command
Dim cell As Range
Dim strSQL As String
Set con = New ADODB.Connection
con.Open "DSN=myDatabase"
' PREPARED STATEMENT WITH QMARK PLACEHOLDERS
strSQL = "INSERT INTO myTable (Col1, Col2, Col3, ...) " _
& " VALUES (?, ?, ?, ...)"
sht = ActiveCell.Worksheet.Name
With Worksheets(sht)
For Each cell In .Range("A1", .Range("A1").End(xlDown))
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = con
.CommandText = strSQL
.CommandType = adCmdText
' BIND PARAMETERS WITH ? IN SQL (ALIGN VALUES TO ADO TYPES)
' FIRST COLUMN OF ROW RANGE
.Parameters.Append .CreateParameter("col1param", adVarChar, adParamInput, , cell.Offset(0, 0).Value)
' SECOND COLUMN OF ROW RANGE
.Parameters.Append .CreateParameter("col2param", adDate, adParamInput, , cell.Offset(0, 1).Value)
' THIRD COLUMN OF ROW RANGE
.Parameters.Append .CreateParameter("col3param", adDecimal, adParamInput, , cell.Offset(0, 2).Value)
'... ADD OTHER COLUMNS
' RUN APPEND ACTION
.Execute
End With
Next cell
con.Close
Set cmd = Nothing: Set con = Nothing
End Sub
uj5u.com熱心網友回復：
我已經使用來自@Parfait 的回圈修改了我的代碼，使其適合我。由于我的 DAO 連接正常作業，我決定堅持使用它。
Sub ToDbase()
'Modified by ployer. This sends values from an exel spreadsheet to your sql database
'with code from Parfait https://stackoverflow.com/questions/71817166/how-do-you-insert-a-range-from-excel-to-an-sql-table
Dim db As DAO.Database 'sql database
Dim rs As DAO.Recordset
Set db = OpenDatabase("myDB", dbDriverNoPrompt, False, "ODBC;DATABASE=myDB_Backup;DSN=myDB")
Dim cell As Range
Dim Value1 As String 'First value to import
Dim Value2 As String 'Second value to import. Add more as needed with the correct types
Dim i As Integer 'for testing in my exel sheet before trying in db
Dim n As Integer 'for testing in my exel sheet before trying in db
i = 1
n = 1
sht = ActiveCell.Worksheet.Name
With Worksheets(sht)
For Each cell In .Range("A1", .Range("A1").End(xlDown))
Value1 = cell.Offset(0, 0).Value 'Assign to variable "Value1" the value stored in Cell at position 0,0 (First time through would be A1)
Value2 = cell.Offset(0, 1).Value 'Assign to variable "Value2" the value stored in Cell at position 0,0 (First time through would be B1)
'For testing if iteration works.
'Cells(i, 5).Value = Value1
'Cells(n, 6).Value = Value2
'i = i 1
'n = n 1
'each time we go through the loop the Value1 and Value2 get sent to Col1 and Col2 in myTable. You need to define the value of Col1, for instance, if in the db it is called Customer it needs to be written Customer here.
db.Execute "INSERT INTO myTable (Col1, Col2) Values ('" & Value1 & "','" & Value2 & "') ", dbFailOnError
Next cell
End With
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/460161.html