使用 VBA 将 Excel 数据导入 SQL 服务器 table
Import Excel data using VBA into a SQL Server table
这是我在 Sheet1 中的 VBA 脚本，其中包含导出和导入
Option Explicit
Private Sub cmdExport_Click()
On Error GoTo ErrExit
Dim cn_ADO As ADODB.Connection
Dim rs_ADO As ADODB.Recordset
Dim cmd_ADO As ADODB.Command
Dim SQLUser As String
Dim SQLPassword As String
Dim SQLServer As String
Dim DBName As String
Dim DbConn As String
Dim SQLQuery As String
Dim strStatus As String
Dim i As Integer
Dim j As Integer
Dim jOffset As Integer
Dim iStartRow As Integer
Dim iStep As Integer
Dim strCurrentValue As String
Dim strLastValue As String
Dim lColorIndex As Integer
iStep = 100
jOffset = 4
iStartRow = 8
i = iStartRow
SQLUser = "sa"
SQLPassword = "12345"
SQLServer = "DESKTOP-5877NMS\SQLEXPRESS"
DBName = "kpi"
DbConn = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=" & SQLUser & ";Password=" & SQLPassword & ";Initial Catalog=" & DBName & ";" & _
"Data Source=" & SQLServer & ";Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;" & _
"Use Encryption for Data=False;Tag with column collation when possible=False"
Set cn_ADO = New ADODB.Connection
cn_ADO.Open DbConn
SQLQuery = "select "
SQLQuery = SQLQuery + "[ID], "
SQLQuery = SQLQuery + "[F2], "
SQLQuery = SQLQuery + "[2019], "
SQLQuery = SQLQuery + "[2020], "
SQLQuery = SQLQuery + "[Jan], "
SQLQuery = SQLQuery + "[Feb], "
SQLQuery = SQLQuery + "[Mar], "
SQLQuery = SQLQuery + "[Apr], "
SQLQuery = SQLQuery + "[May], "
SQLQuery = SQLQuery + "[Jun], "
SQLQuery = SQLQuery + "[Jul], "
SQLQuery = SQLQuery + "[Aug], "
SQLQuery = SQLQuery + "[Sep], "
SQLQuery = SQLQuery + "[Oct], "
SQLQuery = SQLQuery + "[Nov], "
SQLQuery = SQLQuery + "[Dec], "
SQLQuery = SQLQuery + "[2021], "
SQLQuery = SQLQuery + "[Tgt], "
SQLQuery = SQLQuery + "[UOM] "
SQLQuery = SQLQuery + "from "
SQLQuery = SQLQuery + "dbo.RAWDATA1 "
Application.Cursor = xlWait
Application.StatusBar = "Logging onto database..."
Set cmd_ADO = New ADODB.Command
cmd_ADO.CommandText = SQLQuery
cmd_ADO.ActiveConnection = cn_ADO
cmd_ADO.Execute
' Open the recordset.
Set rs_ADO = New ADODB.Recordset
Set rs_ADO.ActiveConnection = cn_ADO
rs_ADO.Open cmd_ADO
Range(Cells(i, 1), Cells(Rows.Count, jOffset + rs_ADO.Fields.Count)).Clear
Cells(1, 1).Select
Application.StatusBar = "Formatting columns..."
'Output Columns names
For j = 0 To rs_ADO.Fields.Count - 1
Cells(i, j + jOffset).Value = rs_ADO.Fields(CLng(j)).Name
Cells(i, j + jOffset).Font.Bold = True
Cells(i, j + jOffset).Select
With Selection.Interior
If rs_ADO.Fields(CLng(j)).Name = "2019" Or _
rs_ADO.Fields(CLng(j)).Name = "2020" Or _
rs_ADO.Fields(CLng(j)).Name = "Jan" Or _
rs_ADO.Fields(CLng(j)).Name = "Feb" Or _
rs_ADO.Fields(CLng(j)).Name = "Mar" Or _
rs_ADO.Fields(CLng(j)).Name = "Apr" Or _
rs_ADO.Fields(CLng(j)).Name = "May" Or _
rs_ADO.Fields(CLng(j)).Name = "Jun" Or _
rs_ADO.Fields(CLng(j)).Name = "Jul" Or _
rs_ADO.Fields(CLng(j)).Name = "Aug" Or _
rs_ADO.Fields(CLng(j)).Name = "Sep" Or _
rs_ADO.Fields(CLng(j)).Name = "Oct" Or _
rs_ADO.Fields(CLng(j)).Name = "Nov" Or _
rs_ADO.Fields(CLng(j)).Name = "Dec" Or _
rs_ADO.Fields(CLng(j)).Name = "2021" Then
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
Else
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End If
End With
Next j
DoEvents
Application.Wait (Now + TimeValue("0:00:01"))
Application.ScreenUpdating = False
strStatus = "Loading data..."
Application.StatusBar = strStatus
lColorIndex = xlNone
'dataset output
While Not rs_ADO.EOF
i = i + 1
strCurrentValue = rs_ADO.Fields(0).Value
If strCurrentValue = strLastValue Then
lColorIndex = lColorIndex
Else
lColorIndex = IIf(lColorIndex = xlNone, 15, xlNone)
End If
For j = 0 To rs_ADO.Fields.Count - 1
Cells(i, j + jOffset).Interior.ColorIndex = lColorIndex
If lColorIndex <> xlNone Then
Cells(i, j + jOffset).Interior.Pattern = xlSolid
End If
Cells(i, j + jOffset).Value = rs_ADO.Fields(j).Value
Next j
rs_ADO.MoveNext
If i - iStartRow < iStep Then
Application.StatusBar = strStatus & " record count: " & i - iStartRow
Else
'a Mod b ==>> a - (b * (a \ b))
If (i - iStartRow) - (iStep * ((i - iStartRow) \ iStep)) = 0 Then
Application.StatusBar = strStatus & " record count: " & i - iStartRow
DoEvents
End If
End If
Wend
'Close ADO and recordset
rs_ADO.Close
Set cn_ADO = Nothing
Set cmd_ADO = Nothing
Set rs_ADO = Nothing
Application.StatusBar = "Total record count: " & i - iStartRow
Application.Cursor = xlDefault
Application.ScreenUpdating = True
Exit Sub
ErrExit:
MsgBox "Error: " & Err & " " & Error(Err)
Application.StatusBar = False
Application.Cursor = xlDefault
If Not cn_ADO Is Nothing Then
Set cn_ADO = Nothing
End If
If Not cmd_ADO Is Nothing Then
Set cmd_ADO = Nothing
End If
If Not rs_ADO Is Nothing Then
Set rs_ADO = Nothing
End If
End Sub
Private Sub cmdImport_Click()
On Error GoTo ErrExit
Dim cn_ADO As ADODB.Connection
Dim cmd_ADO As ADODB.Command
Dim SQLUser As String
Dim SQLPassword As String
Dim SQLServer As String
Dim DBName As String
Dim DbConn As String
Dim SQLQuery As String
Dim strWhere As String
'Dim strStatus As String
Dim i As Integer
'Dim j As Integer
Dim jOffset As Integer
Dim iStartRow As Integer
'Dim iStep As Integer
'Data Columns
Dim strID As String
Dim strF2 As String
Dim str2019 As String
Dim str2020 As String
Dim strJan As String
Dim strFeb As String
Dim strMar As String
Dim strApr As String
Dim strMay As String
Dim strJun As String
Dim strJul As String
Dim strAug As String
Dim strSep As String
Dim strOct As String
Dim strNov As String
Dim strDec As String
Dim str2021 As String
Dim strTgt As String
Dim strUOM As String
'iStep = 100
jOffset = 4
iStartRow = 9
i = iStartRow
SQLUser = "sa"
SQLPassword = "12345"
SQLServer = "DESKTOP-5877NMS\SQLEXPRESS"
DBName = "kpi"
DbConn = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=" & SQLUser & ";Password=" & SQLPassword & ";Initial Catalog=" & DBName & ";" & _
"Data Source=" & SQLServer & ";Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;" & _
"Use Encryption for Data=False;Tag with column collation when possible=False"
Set cn_ADO = New ADODB.Connection
cn_ADO.Open DbConn
Set cmd_ADO = New ADODB.Command
While Cells(i, jOffset).Value <> ""
strID = Cells(i, 0 + jOffset).Value
strF2 = Cells(i, 1 + jOffset).Value
str2019 = Cells(i, 2 + jOffset).Value
str2020 = Cells(i, 3 + jOffset).Value
strJan = Cells(i, 4 + jOffset).Value
strFeb = Cells(i, 5 + jOffset).Value
strMar = Cells(i, 6 + jOffset).Value
strApr = Cells(i, 7 + jOffset).Value
strMay = Cells(i, 8 + jOffset).Value
strJun = Cells(i, 9 + jOffset).Value
strJul = Cells(i, 10 + jOffset).Value
strAug = Cells(i, 11 + jOffset).Value
strSep = Cells(i, 12 + jOffset).Value
strOct = Cells(i, 13 + jOffset).Value
strNov = Cells(i, 14 + jOffset).Value
strDec = Cells(i, 15 + jOffset).Value
str2021 = Cells(i, 16 + jOffset).Value
strTgt = Cells(i, 17 + jOffset).Value
strUOM = Cells(i, 18 + jOffset).Value
strWhere = "ID = " & strID
SQLQuery = "update dbo.RAWDATA1 " & _
"set " & _
"[2019] = '" & str2019 & "', " & _
"[2020] = '" & str2020 & "', " & _
"Jan = '" & strJan & "', " & _
"Feb = '" & strFeb & "', " & _
"Mar = '" & strMar & "', " & _
"Apr = '" & strApr & "', " & _
"May = '" & strMay & "', " & _
"Jun = '" & strJun & "', " & _
"Jul = '" & strJul & "', " & _
"Aug = '" & strAug & "', " & _
"Sep = '" & strSep & "', " & _
"Oct = '" & strOct & "', " & _
"Nov = '" & strNov & "', " & _
"Dec = '" & strDec & "', " & _
"[2021] = '" & str2021 & "' " & _
"where " & strWhere
cmd_ADO.CommandText = SQLQuery
cmd_ADO.ActiveConnection = cn_ADO
cmd_ADO.Execute
i = i + 1
Wend
Set cmd_ADO = Nothing
Set cn_ADO = Nothing
Exit Sub
ErrExit:
MsgBox "Error: " & Err & " " & Error(Err)
Application.StatusBar = False
Application.Cursor = xlDefault
If Not cn_ADO Is Nothing Then
Set cn_ADO = Nothing
End If
If Not cmd_ADO Is Nothing Then
Set cmd_ADO = Nothing
End If
End Sub
这是我的
SQL Table
Excel Data
Export SQL to Excel 完美运行，但是对于 Import Excel to SQL 当我按下 Import 按钮时它显示错误
-2147217913 error converting data type varchar to numeric
我是 VBA 和 SQL 的新手。
将SQL的末尾改为
"[2021] = " & IIF(Len(str2021) = O, "Null",str2021) & _ ' no single quotes
" where " & strWhere ' note added leading space
谢谢你们帮助我。我已经尝试按照 CDP1802 给出的评论和答案中所述更改 SQL 。它工作得很好。但是我尝试将所有值更改为 nvarchar(max) 除了 Id 并且它完美无误地工作。
这是我在 Sheet1 中的 VBA 脚本，其中包含导出和导入
Option Explicit
Private Sub cmdExport_Click()
On Error GoTo ErrExit
Dim cn_ADO As ADODB.Connection
Dim rs_ADO As ADODB.Recordset
Dim cmd_ADO As ADODB.Command
Dim SQLUser As String
Dim SQLPassword As String
Dim SQLServer As String
Dim DBName As String
Dim DbConn As String
Dim SQLQuery As String
Dim strStatus As String
Dim i As Integer
Dim j As Integer
Dim jOffset As Integer
Dim iStartRow As Integer
Dim iStep As Integer
Dim strCurrentValue As String
Dim strLastValue As String
Dim lColorIndex As Integer
iStep = 100
jOffset = 4
iStartRow = 8
i = iStartRow
SQLUser = "sa"
SQLPassword = "12345"
SQLServer = "DESKTOP-5877NMS\SQLEXPRESS"
DBName = "kpi"
DbConn = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=" & SQLUser & ";Password=" & SQLPassword & ";Initial Catalog=" & DBName & ";" & _
"Data Source=" & SQLServer & ";Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;" & _
"Use Encryption for Data=False;Tag with column collation when possible=False"
Set cn_ADO = New ADODB.Connection
cn_ADO.Open DbConn
SQLQuery = "select "
SQLQuery = SQLQuery + "[ID], "
SQLQuery = SQLQuery + "[F2], "
SQLQuery = SQLQuery + "[2019], "
SQLQuery = SQLQuery + "[2020], "
SQLQuery = SQLQuery + "[Jan], "
SQLQuery = SQLQuery + "[Feb], "
SQLQuery = SQLQuery + "[Mar], "
SQLQuery = SQLQuery + "[Apr], "
SQLQuery = SQLQuery + "[May], "
SQLQuery = SQLQuery + "[Jun], "
SQLQuery = SQLQuery + "[Jul], "
SQLQuery = SQLQuery + "[Aug], "
SQLQuery = SQLQuery + "[Sep], "
SQLQuery = SQLQuery + "[Oct], "
SQLQuery = SQLQuery + "[Nov], "
SQLQuery = SQLQuery + "[Dec], "
SQLQuery = SQLQuery + "[2021], "
SQLQuery = SQLQuery + "[Tgt], "
SQLQuery = SQLQuery + "[UOM] "
SQLQuery = SQLQuery + "from "
SQLQuery = SQLQuery + "dbo.RAWDATA1 "
Application.Cursor = xlWait
Application.StatusBar = "Logging onto database..."
Set cmd_ADO = New ADODB.Command
cmd_ADO.CommandText = SQLQuery
cmd_ADO.ActiveConnection = cn_ADO
cmd_ADO.Execute
' Open the recordset.
Set rs_ADO = New ADODB.Recordset
Set rs_ADO.ActiveConnection = cn_ADO
rs_ADO.Open cmd_ADO
Range(Cells(i, 1), Cells(Rows.Count, jOffset + rs_ADO.Fields.Count)).Clear
Cells(1, 1).Select
Application.StatusBar = "Formatting columns..."
'Output Columns names
For j = 0 To rs_ADO.Fields.Count - 1
Cells(i, j + jOffset).Value = rs_ADO.Fields(CLng(j)).Name
Cells(i, j + jOffset).Font.Bold = True
Cells(i, j + jOffset).Select
With Selection.Interior
If rs_ADO.Fields(CLng(j)).Name = "2019" Or _
rs_ADO.Fields(CLng(j)).Name = "2020" Or _
rs_ADO.Fields(CLng(j)).Name = "Jan" Or _
rs_ADO.Fields(CLng(j)).Name = "Feb" Or _
rs_ADO.Fields(CLng(j)).Name = "Mar" Or _
rs_ADO.Fields(CLng(j)).Name = "Apr" Or _
rs_ADO.Fields(CLng(j)).Name = "May" Or _
rs_ADO.Fields(CLng(j)).Name = "Jun" Or _
rs_ADO.Fields(CLng(j)).Name = "Jul" Or _
rs_ADO.Fields(CLng(j)).Name = "Aug" Or _
rs_ADO.Fields(CLng(j)).Name = "Sep" Or _
rs_ADO.Fields(CLng(j)).Name = "Oct" Or _
rs_ADO.Fields(CLng(j)).Name = "Nov" Or _
rs_ADO.Fields(CLng(j)).Name = "Dec" Or _
rs_ADO.Fields(CLng(j)).Name = "2021" Then
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
Else
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End If
End With
Next j
DoEvents
Application.Wait (Now + TimeValue("0:00:01"))
Application.ScreenUpdating = False
strStatus = "Loading data..."
Application.StatusBar = strStatus
lColorIndex = xlNone
'dataset output
While Not rs_ADO.EOF
i = i + 1
strCurrentValue = rs_ADO.Fields(0).Value
If strCurrentValue = strLastValue Then
lColorIndex = lColorIndex
Else
lColorIndex = IIf(lColorIndex = xlNone, 15, xlNone)
End If
For j = 0 To rs_ADO.Fields.Count - 1
Cells(i, j + jOffset).Interior.ColorIndex = lColorIndex
If lColorIndex <> xlNone Then
Cells(i, j + jOffset).Interior.Pattern = xlSolid
End If
Cells(i, j + jOffset).Value = rs_ADO.Fields(j).Value
Next j
rs_ADO.MoveNext
If i - iStartRow < iStep Then
Application.StatusBar = strStatus & " record count: " & i - iStartRow
Else
'a Mod b ==>> a - (b * (a \ b))
If (i - iStartRow) - (iStep * ((i - iStartRow) \ iStep)) = 0 Then
Application.StatusBar = strStatus & " record count: " & i - iStartRow
DoEvents
End If
End If
Wend
'Close ADO and recordset
rs_ADO.Close
Set cn_ADO = Nothing
Set cmd_ADO = Nothing
Set rs_ADO = Nothing
Application.StatusBar = "Total record count: " & i - iStartRow
Application.Cursor = xlDefault
Application.ScreenUpdating = True
Exit Sub
ErrExit:
MsgBox "Error: " & Err & " " & Error(Err)
Application.StatusBar = False
Application.Cursor = xlDefault
If Not cn_ADO Is Nothing Then
Set cn_ADO = Nothing
End If
If Not cmd_ADO Is Nothing Then
Set cmd_ADO = Nothing
End If
If Not rs_ADO Is Nothing Then
Set rs_ADO = Nothing
End If
End Sub
Private Sub cmdImport_Click()
On Error GoTo ErrExit
Dim cn_ADO As ADODB.Connection
Dim cmd_ADO As ADODB.Command
Dim SQLUser As String
Dim SQLPassword As String
Dim SQLServer As String
Dim DBName As String
Dim DbConn As String
Dim SQLQuery As String
Dim strWhere As String
'Dim strStatus As String
Dim i As Integer
'Dim j As Integer
Dim jOffset As Integer
Dim iStartRow As Integer
'Dim iStep As Integer
'Data Columns
Dim strID As String
Dim strF2 As String
Dim str2019 As String
Dim str2020 As String
Dim strJan As String
Dim strFeb As String
Dim strMar As String
Dim strApr As String
Dim strMay As String
Dim strJun As String
Dim strJul As String
Dim strAug As String
Dim strSep As String
Dim strOct As String
Dim strNov As String
Dim strDec As String
Dim str2021 As String
Dim strTgt As String
Dim strUOM As String
'iStep = 100
jOffset = 4
iStartRow = 9
i = iStartRow
SQLUser = "sa"
SQLPassword = "12345"
SQLServer = "DESKTOP-5877NMS\SQLEXPRESS"
DBName = "kpi"
DbConn = "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=" & SQLUser & ";Password=" & SQLPassword & ";Initial Catalog=" & DBName & ";" & _
"Data Source=" & SQLServer & ";Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;" & _
"Use Encryption for Data=False;Tag with column collation when possible=False"
Set cn_ADO = New ADODB.Connection
cn_ADO.Open DbConn
Set cmd_ADO = New ADODB.Command
While Cells(i, jOffset).Value <> ""
strID = Cells(i, 0 + jOffset).Value
strF2 = Cells(i, 1 + jOffset).Value
str2019 = Cells(i, 2 + jOffset).Value
str2020 = Cells(i, 3 + jOffset).Value
strJan = Cells(i, 4 + jOffset).Value
strFeb = Cells(i, 5 + jOffset).Value
strMar = Cells(i, 6 + jOffset).Value
strApr = Cells(i, 7 + jOffset).Value
strMay = Cells(i, 8 + jOffset).Value
strJun = Cells(i, 9 + jOffset).Value
strJul = Cells(i, 10 + jOffset).Value
strAug = Cells(i, 11 + jOffset).Value
strSep = Cells(i, 12 + jOffset).Value
strOct = Cells(i, 13 + jOffset).Value
strNov = Cells(i, 14 + jOffset).Value
strDec = Cells(i, 15 + jOffset).Value
str2021 = Cells(i, 16 + jOffset).Value
strTgt = Cells(i, 17 + jOffset).Value
strUOM = Cells(i, 18 + jOffset).Value
strWhere = "ID = " & strID
SQLQuery = "update dbo.RAWDATA1 " & _
"set " & _
"[2019] = '" & str2019 & "', " & _
"[2020] = '" & str2020 & "', " & _
"Jan = '" & strJan & "', " & _
"Feb = '" & strFeb & "', " & _
"Mar = '" & strMar & "', " & _
"Apr = '" & strApr & "', " & _
"May = '" & strMay & "', " & _
"Jun = '" & strJun & "', " & _
"Jul = '" & strJul & "', " & _
"Aug = '" & strAug & "', " & _
"Sep = '" & strSep & "', " & _
"Oct = '" & strOct & "', " & _
"Nov = '" & strNov & "', " & _
"Dec = '" & strDec & "', " & _
"[2021] = '" & str2021 & "' " & _
"where " & strWhere
cmd_ADO.CommandText = SQLQuery
cmd_ADO.ActiveConnection = cn_ADO
cmd_ADO.Execute
i = i + 1
Wend
Set cmd_ADO = Nothing
Set cn_ADO = Nothing
Exit Sub
ErrExit:
MsgBox "Error: " & Err & " " & Error(Err)
Application.StatusBar = False
Application.Cursor = xlDefault
If Not cn_ADO Is Nothing Then
Set cn_ADO = Nothing
End If
If Not cmd_ADO Is Nothing Then
Set cmd_ADO = Nothing
End If
End Sub
这是我的
SQL Table
Excel Data
Export SQL to Excel 完美运行，但是对于 Import Excel to SQL 当我按下 Import 按钮时它显示错误
-2147217913 error converting data type varchar to numeric
我是 VBA 和 SQL 的新手。
将SQL的末尾改为
"[2021] = " & IIF(Len(str2021) = O, "Null",str2021) & _ ' no single quotes
" where " & strWhere ' note added leading space
谢谢你们帮助我。我已经尝试按照 CDP1802 给出的评论和答案中所述更改 SQL 。它工作得很好。但是我尝试将所有值更改为 nvarchar(max) 除了 Id 并且它完美无误地工作。