vbaコードを使用してSQL ServerテーブルからExcelデータを更新するにはどうすればよいですか？

Question

私はテーブルを持っており、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： メッセージボックス（エラー）

End Subの

おかげで、 H

Answer 1

あなたは（あなたの任意のヒットを取得したことがないので）

' 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

あなたの分岐コードがあるだけで、クエリの実行を「挿入」なぜそうなことだ、末尾のスペースであなたのwhere句の最後の4つの変数をパディングしています違う。 1つの配列を持ってみてください。

私は

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

に

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

を変更示唆し、その後にqueriesArrayからSQLを実行します。