如何使用vba代码从excel数据更新Sql服务器表？

Question

我有一个表，我试图从电子表格使用vba更新sql表月列，但它似乎并没有工作。我从昨天起编辑了vba代码，并且出现错误“当对象关闭时不允许操作。”我是vba编程新手，所以任何帮助表示赞赏。

CREATE TABLE [dbo].[Actual_FTE](
[EmpID] [nvarchar](15) NOT NULL, 
[EName] [nvarchar](50) NULL, 
[CCNum] [nvarchar](10) NOT NULL, 
[CCName] [nvarchar](50) NULL, 
[ProgramNum] [nvarchar](10) NULL, 
[ProgramName] [nvarchar](50) NULL, 
[ResTypeNum] [nvarchar](10) NULL, 
[ResName] [nvarchar](50) NULL, 
[January] [nvarchar](50) NULL, 
[February] [nvarchar](50) NULL, 
[March] [nvarchar](50) NULL, 
[April] [nvarchar](50) NULL, 
[May] [nvarchar](50) NULL, 
[June] [nvarchar](50) NULL, 
[July] [nvarchar](50) NULL, 
[August] [nvarchar](50) NULL, 
[September] [nvarchar](50) NULL, 
[October] [nvarchar](50) NULL, 
[November] [nvarchar](50) NULL, 
[December] [nvarchar](50) NULL, 
[Total_Year] [nvarchar](50) NULL, 
[Year] [nvarchar](6) NULL, 
[Scenario] [nvarchar](10) NULL 

）

VBA代码是：

Public Sub UpdateToDatabase() 

Dim sBackupUpdQry As String 
Dim sBackupInsQry As String 

Dim sUpdQry As String 
Dim sInsQry As String 
Dim sExistQry As String 
Dim sWhere As String 

Dim iRows As Integer 
Dim iCols As Integer 

On Error GoTo ErrHandler 




'Find last row and last column 
Dim lLastRow As Long 
Dim lLastCol As Integer 
lLastRow = Cells.Find("*", Range("A4"), xlFormulas, , xlByRows, xlPrevious).Row ' Find the last row with data 
lLastCol = Cells.Find("*", Range("A4"), xlFormulas, , xlByColumns, xlPrevious).Column ' Find the last column with data 


Dim qryUpdateArray(2000) As String 
Dim qryInsertArray(2000) As String 
Dim qryExistArray(2000) As String 
Dim iRecCount As Integer 
Dim sCellVal As String 
Dim sColName As String 


With Sheets("Main") 

    sBackupUpdQry = "UPDATE Actual_FTE SET " ' predefined value of variable to concatenate for further at the time of updation 
    sBackupInsQry = "INSERT INTO Actual_FTE (" 
    sWhere = "" 

    'starting from row3, which is the header/column-name row 
    'prepare the insert/update queries 
    iRows = 3 
    iRecCount = 1 
    For iCols = 1 To lLastCol 
     sColName = Cells(iRows, iCols) 


     If (sColName = "") Then 
      MsgBox ("Empty Column Name") 
      Exit Sub 
     End If 

     If (iCols = 1) Then 
      sBackupInsQry = sBackupInsQry + sColName 
     Else 
      sBackupInsQry = sBackupInsQry + ("," + sColName) 
     End If 
    Next iCols 
    sBackupInsQry = sBackupInsQry + ")VALUES(" 


    'loop through each column to add the insert/update data 
    For iRecCount = 1 To lLastRow - 3 
     iRows = iRows + 1 
     sUpdQry = sBackupUpdQry 
     sInsQry = sBackupInsQry 

     For iCols = 1 To lLastCol 
      sColName = CStr(Cells(3, iCols)) 



      sCellVal = CStr(Cells(iRows, iCols)) 
      If (InStr(1, sCellVal, "'")) Then 
       sCellVal = Replace(sCellVal, "'", "''") 
      End If 

      If (iCols = 1) Then 
       sUpdQry = sUpdQry + (sColName + "='" + sCellVal + "'") 
       sInsQry = sInsQry + ("'" + sCellVal + "'") 

       Else 
       sUpdQry = sUpdQry + ("," + sColName + "='" + sCellVal + "'") 
       sInsQry = sInsQry + (",'" + sCellVal + "'") 

      End If 


     Next iCols 

     sInsQry = sInsQry + ")" 
     sUpdQry = sUpdQry + sWhere 

     'save all queries into string array, maximum 1000 
     qryUpdateArray(iRecCount) = sUpdQry 
     qryInsertArray(iRecCount) = sInsQry 
     qryExistArray(iRecCount) = sExistQry 

    Next iRecCount 


End With 

Call DBConnection.OpenDBConnection 

Dim rsMY_Resources As ADODB.Recordset 
Set rsMY_Resources = New ADODB.Recordset 


Dim cntUpd As Integer 
Dim cntIns As Integer 
cntUpd = 0 
cntIns = 0 

For iRecCount = 1 To lLastRow - 3 
    'check if the asset number exists. 
    'MsgBox qryExistArray(iRecCount) 
    Set rsMY_Resources = oConn.Execute(qryExistArray(iRecCount)) 

    'if exists, update the record; if not, insert a new record 
    If (rsMY_Resources.Fields(0).Value = 0) Then 
     'MsgBox "Insert" 
     'MsgBox qryInsertArray(iRecCount) 
     oConn.Execute qryInsertArray(iRecCount) 
     cntIns = cntIns + 1 
    Else 
     'MsgBox "Update" 
     'MsgBox qryUpdateArray(iRecCount) 
     oConn.Execute qryUpdateArray(iRecCount) 
     cntUpd = cntUpd + 1 
    End If 
Next iRecCount 

'Clean up 
rsMY_Resources.Close: 
Set rsMY_Resources = Nothing 

Call DBConnection.CloseDBConnection 
MsgBox ("Actual_FTE table has been updated: " + CStr(cntUpd) + " records have been updated; " + CStr(cntIns) + " new records have been inserted") 


Exit Sub 

ErrHandler： MSGBOX（错误）

结束子

谢谢， ħ

Answer 1

你填充在where子句中的最后4个变量后面有个空格，所以可能这就是为什么只有“插入”查询运行（因为你在那里从来没有得到任何点击）

' construct the where clause 
    sWhere = " Where EmpID = '" + strEmpID + "' 
    and CCNum = '" + strCCNum + "' 
    and ProgramNum = '" + strProgramNum + "' 
    and ResTypeNum = '" + strResTypeNum + " ' 
    and Total_Year = '" + strTotal_year + " ' 
    and Year = '" + strYear + " ' 
    and Scenario = '" + strScenario + " '" 

Answer 2

你的分支代码错误。尝试有一个数组。

我建议改变

'save all queries into string array, maximum 1000 
    qryUpdateArray(iRecCount) = sUpdQry 
    qryInsertArray(iRecCount) = sInsQry 
    qryExistArray(iRecCount) = sExistQry 

到

'save all queries into string array, maximum 1000 
    if sExistQry = '1' then 
     queriesArray(iRecCount) = sUpdQry 
    else 
     queriesArray(iRecCount) = sInsQry 
    end if 

再后来就运行从queriesArray的SQL。