Question

我有一个包含2个按钮的电子表格 - 检索行和更新行。表字段是EmpID，EName，Grouping，CCNum，CCName，ResTypeNum，ResName和Status。除了EmpID和EName列之外，所有其他列都是可编辑的。为此，我选择了列A和B＆gt;格式化单元格＆gt;保护＆gt;已锁定。然后在Protect Sheet中的Review选项卡下，我检查了＆＃34;选择未锁定的单元格＆＃34;选项。现在对于Retrieve行，这里是宏，后面跟着Update行的宏。更新行不会更新任何更改，也不会给出错误。存储的过程工作正常但是通过excel完成时无法正常工作。请看一下。我不希望用户更新A列和B列。

  Public Sub Button1_Click()

  ActiveSheet.Unprotect  



Dim sQry As String
Dim iRows As Integer
Dim iCols As Integer
Dim SQL As String



On Error GoTo ErrHandler



Call ClearExistingRows(4)


Call DBConnection.OpenDBConnection


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

SQL = "SELECT EmpID, EName, [Grouping], CCNum, CCName, ResTypeNum, ResName, Status from Employee_FTE Order by Status"


rsMY_Resources.Open SQL, DBConnection.oConn, adOpenStatic, adLockReadOnly
If rsMY_Resources.EOF = True Then
    MsgBox ("No record found in database")
    Exit Sub
End If

iRows = 3
For iCols = 0 To rsMY_Resources.Fields.Count - 1
    ActiveSheet.Cells(iRows, iCols + 1).Value = rsMY_Resources.Fields(iCols).Name
Next
ActiveSheet.Range(ActiveSheet.Cells(iRows, 1), ActiveSheet.Cells(iRows, rsMY_Resources.Fields.Count)).Font.Bold = True

iRows = iRows + 1
ActiveSheet.Range("A" + CStr(iRows)).CopyFromRecordset rsMY_Resources

iRows = rsMY_Resources.RecordCount


rsMY_Resources.Close:
Set rsMY_Resources = Nothing

Call DBConnection.CloseDBConnection



MsgBox (CStr(iRows) + " records have been retrieved from the database!")

 With Range("G4:G100").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:="=listdata1"
 End With

 With Range("H4:H100").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
 Operator:=xlBetween, Formula1:="=listdata"
 End With

 With Range("E4:E100").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
 Operator:=xlBetween, Formula1:="=listdata2"
 End With


Columns("C:H").Select
Selection.Locked = False
ActiveSheet.Protect

Exit Sub

ErrHandler:
MsgBox (Error)

End Sub

这是“更新”按钮的宏。

  Sub Employee_Button2_Click()


  Dim sBackupUpdQry As String

  Dim sUpdQry As String

  Dim iRows As Integer

  Dim qryUpdateArray(4000) As String

  Dim iCols As Integer



  On Error GoTo ErrHandler


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


   Dim iRecCount As Integer


   With Sheets("Select and Update Employee")

    sBackupUpdQry = "EXEC usp_UpdateEmployee_FTE" 


    iRows = 3
    iRecCount = 1




        For iRecCount = 1 To lLastRow - 3

        iRows = iRows + 1
        sUpdQry = ""






      sUpdQry = sUpdQry + " , @ENameParm = '" + CStr(Cells(iRows, 2)) + "'"
      sUpdQry = sUpdQry + " , @GroupingParm = '" + CStr(Cells(iRows, 3)) + "'"
      sUpdQry = sUpdQry + " , @CCNumParm = '" + CStr(Cells(iRows, 4)) + "'"
      sUpdQry = sUpdQry + " , @CCNameParm = '" + CStr(Cells(iRows, 5)) + "'"
      sUpdQry = sUpdQry + " , @ResTypeNumParm = '" + CStr(Cells(iRows, 6)) + "'"
      sUpdQry = sUpdQry + " , @ResNameParm = '" + CStr(Cells(iRows, 7)) + "'"
      sUpdQry = sUpdQry + " , @StatusParm = '" + CStr(Cells(iRows, 8)) + "'"


    sUpdQry = sBackupUpdQry + " @EmpIDParm = '" + CStr(Cells(iRows, 1)) + "' " + sUpdQry

    qryUpdateArray(iRecCount) = sUpdQry


    Next iRecCount



     End With


     Call DBConnection.OpenDBConnection

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


     Dim cntUpd As Integer
     cntUpd = 0

     For iRecCount = 1 To lLastRow - 3

           If qryUpdateArray(iRecCount) > "" Then

           oConn.Execute qryUpdateArray(iRecCount)
           cntUpd = cntUpd + 1
           End If

     Next iRecCount

     Call DBConnection.CloseDBConnection
     MsgBox ("Employee_FTE has been updated")

     Exit Sub

     ErrHandler:
     MsgBox (Error)



     End Sub

这里存储的Proc：

    ALTER PROCEDURE [dbo].[usp_UpdateEmployee_FTE]
    @EmpIDParm nvarchar(15),
    @ENameParm      nvarchar(10),
    @GroupingParm nvarchar(50),
    @CCNumParm nvarchar(50),
    @CCNameParm nvarchar(50),   
    @ResTypeNumParm nvarchar(50),
    @ResNameParm nvarchar(50),
    @StatusParm nvarchar(50)



     AS
     BEGIN
    DECLARE @UpdateStr varchar(5000), @SQLCommand varchar(5000)

    SET NOCOUNT ON;

    SET @EmpIDParm = rtrim(Ltrim(@EmpIDParm))

    SET @UpdateStr = ''









        If @GroupingParm <> '' 
        If @UpdateStr = '' 
            SET @UpdateStr = @UpdateStr + 'Grouping = ' + '''' + 
         @GroupingParm + ''''
         else
            SET @UpdateStr = @UpdateStr + ',Grouping = ' + '''' + 
         @GroupingParm + ''''

        If @CCNumParm <> '' 
        If @UpdateStr = '' 
            SET @UpdateStr = @UpdateStr + 'CCNum = ' + '''' + @CCNumParm + ''''
        else
            SET @UpdateStr = @UpdateStr + ',CCNum = ' + '''' + @CCNumParm + ''''

            If @CCNameParm <> '' 
        If @UpdateStr = '' 
            SET @UpdateStr = @UpdateStr + 'CCName = ' + '''' + @CCNameParm + ''''
        else
            SET @UpdateStr = @UpdateStr + ',CCName = ' + '''' + @CCNameParm + ''''

    If @ResTypeNumParm <> '' 
        If @UpdateStr = '' 
            SET @UpdateStr = @UpdateStr + 'ResTypeNum = ' + '''' + @ResTypeNumParm + ''''
        else
            SET @UpdateStr = @UpdateStr + ',ResTypeNum = ' + '''' + @ResTypeNumParm + ''''

    If @ResNameParm <> '' 
        If @UpdateStr = '' 
            SET @UpdateStr = @UpdateStr + 'ResName = ' + '''' + @ResNameParm + ''''
        else
            SET @UpdateStr = @UpdateStr + ',ResName = ' + '''' + @ResNameParm + ''''

    If @StatusParm <> '' 
        If @UpdateStr = '' 
            SET @UpdateStr = @UpdateStr + 'Status = ' + '''' + @StatusParm + ''''
        else
            SET @UpdateStr = @UpdateStr + ',Status = ' + '''' + @StatusParm + ''''


    -- FInal prep for the Update statement
    SET @SQLCommand = 'Update Employee_FTE Set ' + @UpdateStr + ' Where EmpID = ' + '''' + @EmpIDParm + '''' + ' and EName = ' + '''' + @ENameParm + '''' 

    -- execute the update command
    EXEC (@SQLCommand)


END

谢谢， HEMA

vba更新sql表无法正常工作

0 个答案: