1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
|
Sub to_sqlserver()
Table = "Hires"
parameters (Table) ' save table column parameters into tb_param
List = SelectCol(tb_param, 2, list_header) ' select column names : Col1,Col2,Col3,Col4,Col5,Col6,Col7,Col8
List = SelectCol(tb_param, 5, list_values) ' select as much "?" as column names : ?,?,?,?,?,?,?,?
maintable (Table) 'select table values into tb_main
datadb = "dbo.HRHirescopy"
strSQL = "INSERT INTO " & datadb & _
" (ID," & list_header & ") " & _
"VALUES ((SELECT ISNULL(MAX(ID) + 1, 0) FROM " & datadb & ")," & list_values & ");"
MsgBox (strSQL)
pServer = "Servername"
pCatalog = "DBname"
strConn = "Provider=SQLOLEDB" & _
";Initial Catalog=" & pCatalog & _
";Data Source=" & pServer & _
";Integrated Security=SSPI"
Set conn = New ADODB.Connection
conn.Open strConn
Set cmd = New ADODB.Command
cmd.ActiveConnection = conn
cmd.CommandType = adCmdText
cmd.CommandText = strSQL
' Loop on the values to be transferred
For i = 2 To UBound(tb_main, 1)
For j = 2 To UBound(tb_main, 2)
' Loop on the column parameters to be transferred
For k = 2 To UBound(tb_param, 1)
If LCase(tb_main(1, j)) = LCase(tb_param(k, 2)) Then
cmd.parameters.Append _
cmd.CreateParameter(tb_param(k, 2), tb_param(k, 3), adParamInput, _
Len(tb_main(i, j)), tb_main(i, j))
End If
Next
Next
cmd.Execute ' ERROR OCCUR HERE
Next
conn.Close
Set conn = Nothing
End Sub |
Partager