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 |
