Question

我有一个表，我正在尝试使用vba从电子表格更新sql表Month列，但它似乎不起作用。我从昨天编辑了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（错误）

End Sub

谢谢， ħ

Answer 1

您使用尾随空格填充where子句中的最后4个变量，这可能就是为什么只有＆＃34;插入＆＃34;查询运行（因为你的地方永远不会有任何命中）

  ' 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

您的分支代码错误。尝试使用一个阵列。

我建议改变

<div class="power" style="width:{{ width_list[-1] | sort }}"></div>

到

class test {
 public:
    test()
      : map_{{23, 1345}, {43, -8745}} {}

 private:
   const std::unordered_map<long, long> map_;
 };

然后稍后从queriesArray运行sql。

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

2 个答案: