2015-01-16 142 views
0

我有一個excel工作簿,它是一個項目計劃模板,PM填充信息並將其加載到sql數據庫中。目前該過程是否通過裝載兩個表的批處理過程(1個具有1行數據,另一個具有多個記錄)。我正在改變它是一個直接從excel插入到SQL Server通過vba插入。我有插入工作,但每個表都有一個項目ID列,這是PK。下午可能更新並保存該文件多次。表格會根據最新的保存信息進行更新。我已經通過在代碼中添加刪除語句並插入更新的記錄來解決此問題。這對於有1條記錄的表格非常有用,但是我無法獲得帶有多條記錄的表格。它會刪除記錄,並通過插入的第一個循環,然後返回到刪除並刪除記錄。在插入之前刪除SQL服務器表中的記錄

我附加了多表刪除和插入的代碼。有人能告訴我我做錯了什麼嗎?

Public Sub exportprojdetaildata() 

Dim stSQL As String 
Dim conn As New ADODB.Connection 
Dim rs As New ADODB.Recordset 
Dim strConn As String 
Dim iRowNo As Integer 
Dim targetedFieldNames As Variant 
Dim rowData As Variant 
Dim lastrow As Long 
Dim sql As String 
Dim i As Integer 
Dim cvt As Double 
Dim aField As String 
Dim compare As Variant 
Dim value As Variant 
Dim dvalue As Long 


With Sheets("Data") 

    lastrow = .Range("A:A").Find(what:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row 
    'Open a connection to SQL Server 
    conn.Open _ 
    "Provider=SQLOLEDB;Data Source=PWIRTPAUDD1HV8;Initial Catalog=STAR;User Id=STAR_USER;Password=dcistarrtp" 

    'Skip the header row 
    iRowNo = 2 

    targetedFieldNames = Join(WorksheetFunction.Transpose(wks_TargetFieldNames.Range("targetedFieldNames").value), "," & vbNewLine) 

    Do While iRowNo <= lastrow 
     rowData = wks_BackgroundData.Range("A" & iRowNo & ":AV" & iRowNo).value 

       compare = wks_BackgroundData.Range("AV2").value 


     'Generate and execute sql statement to import the excel rows to SQL Server table 
      With rs 
       .ActiveConnection = conn 
       .Open "Select proj_id from dbo.STAR_DC_INITIAL_ProjectDetails_ExcelDevCopy where proj_id = " & compare 

       wks_BackgroundData.Range("BA2").CopyFromRecordset rs 


       .Close 
      End With 

         value = wks_BackgroundData.Range("BA2").value 

       If compare = value Then 
         sql = "delete from dbo.STAR_DC_INITIAL_ProjectDetails_ExcelDevCopy where proj_id = " & value 


       conn.Execute sql 
       Else 

       sql = "insert into dbo.STAR_DC_INITIAL_ProjectDetails_ExcelDevCopy (" 
       sql = sql & targetedFieldNames 
    '   Debug.Print sql 
       sql = sql & ") values (" & vbNewLine 
    '   Debug.Print sql 

     'couldn't do transpose since rowData represents a row, not a column 
     For i = 1 To UBound(rowData, 2) 
      aField = Replace(rowData(1, i), "'", "''") 
     'escape single quotes 
      Select Case i 
       Case 1, 6, 16, 17, 23 To 47 
       ' cvt = CDbl(aField) 
        If aField = vbNullString Then 
         sql = sql & "Null," & vbNewLine 
        Else 
         sql = sql & aField & "," & vbNewLine 
        End If 
       Case 2 To 5, 7 To 15, 18 To 22 
        sql = sql & "'" & aField & "', " & vbNewLine 
       Case 48 
        If aField = vbNullString Then 
         sql = sql & "Null" 
        Else 
         sql = sql & aField 
        End If 


       End Select 
     Next i 
     sql = sql & ");" 
     'sql = sql & "');" 

     ' End If 

     conn.Execute sql 

     iRowNo = iRowNo + 1 

    Loop 

    End If  


    conn.Close 
    Set conn = Nothing 


End With 

末次

+0

你不應該使用VBA來做到這一點。 –

+0

然後我應該使用什麼? – ncwright

+0

如果您希望PM通過Excel進行更新,那麼我明白您爲什麼要使用vba進行更新並與您達成一致。您可以在1行(標題)表上添加刪除觸發器,當記錄從那裏刪除時,它會刪除多行(詳細)表。或者添加一個外鍵並在刪除時啓用級聯刪除。 – Dbloch

回答

0

很難確定沒有看到您要保存的數據,但我懷疑您有邏輯錯誤。

rowData的值在循環中動態構建。哪個是對的。

rowData = wks_BackgroundData.Range("A" & iRowNo & ":AV" & iRowNo).value 

但是compare和value的值總是從循環內的相同位置讀取。所以刪除語句將會一遍又一遍地執行。

compare = wks_BackgroundData.Range("AV2").value 
value = wks_BackgroundData.Range("BA2").value 

應該比較值還是不能動態讀取?

compare = wks_BackgroundData.Range("AV" & iRowNo).value 
value = wks_BackgroundData.Range("BA" & iRowNo).value 

或者

你應該將delete語句的循環之外,以確保它只是執行一次

或者

你應該保持一個標誌,將指示刪除已經被執行了,不再執行它。

hasExecuted = false <- OUTSIDE THE LOOP 
... 
... 
If compare = value and hasExecuted = false Then 
    sql = "delete from dbo.STAR_DC_INITIAL_ProjectDetails_ExcelDevCopy where proj_id = " & value 
    conn.Execute sql 
    hasExecuted = true 
... 
... 

此外,我不認爲你應該有一個IF x = y然後刪除ELSE INSERT。如果它不是IF x = y那麼刪除,並且總是INSERT。有了else,它只會在記錄不存在的情況下插入,但如果它刪除了記錄,它將永遠不會插入新記錄。

希望幫助位

+0

謝謝Spock。我能夠使用hasExecuted並將查找更改爲動態讀取。 – ncwright

+0

如果它幫助您解決問題,請將其標記爲答案 – Spock

0

避免使用VBA進行新的開發工作。如果您需要不斷地將這個Excel文檔插入到SQL Server數據庫中,然後通過SQL Agent輕鬆地將其設置爲計劃任務,或者簡單地按照下面的屏幕截圖進行操作,這是一個無代碼且容易可配置的將平面文件/數據庫表導入到SQL Server中。最後,從可用性的角度來看,有許多更好的方法可以跟蹤Excel工作表或表單數據(SharePoint,Excel 2013,Access,雲/本地驅動器)或使用內部WordPress分配插件,如WP-document revisionsSQL Server Import Export

+0

我很想做這樣的事情,但是這個現有的發展,我只是在工作簿中添加幾個潛艇。這是一個模板,然後pm下拉並用於他們的項目。這些被許多下午使用,所以這是我能做到的唯一方法。這樣做的唯一理由是,當前數據庫所在服務器所在的組希望從其維護業務中解脫出來。 – ncwright

+0

VBA已被棄用,並且我相信微軟已經不支持半年的時間了。 –

0

如上所述以上我用斯波克除了用於比較和值的變量值的動態查找的。一旦我這樣做,我添加了hasExecuted標誌。

Public Sub exportprojinfodata() 

    Dim stSQL As String 
    Dim conn As New ADODB.Connection 
    Dim rs As New ADODB.Recordset 
    Dim strConn As String 
Dim iRowNo As Integer 
Dim targetFieldNames As Variant 
Dim rowData As Variant 
Dim lastrow As Long 
Dim sql As String 
Dim i As Integer 
Dim aField As String 
Dim compare As Variant 
Dim value As Variant 
Dim hasExecuted As String 


hasExecuted = False 



With Sheets("Data2") 

    lastrow = .Range("A:A").Find(what:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row 
    'Open a connection to SQL Server 
    conn.Open _ 
     "Provider=SQLOLEDB;Data Source=PWIRTPAUDD1HV8;Initial Catalog=STAR;User Id=STAR_USER;Password=dcistarrtp" 

    'Skip the header row 
    iRowNo = 2 

    targetFieldNames = Join(WorksheetFunction.Transpose(wks_TargetFieldNames.Range("TargetFieldNames").value), "," & vbNewLine) 



    Do While iRowNo <= lastrow 
     rowData = wks_ProjDescription.Range("A" & iRowNo & ":AO" & iRowNo).value 


     compare = wks_ProjDescription.Range("B"& iRowNo).value 

     'Generate and execute sql statement to import the excel rows to SQL Server table 

      With rs 
       .ActiveConnection = conn 
       .Open "Select proj_id from dbo.STAR_DC_INITIAL_ProjectInfo_ExcelDevCopy where proj_id= " & compare 
       wks_ProjDescription.Range("AX2").CopyFromRecordset rs 
       .Close 
      End With 

      value = wks_ProjDescription.Range("AX"& iRowNo).value 

      If compare = value And hasExecuted = False Then 
       stSQL = "delete from dbo.STAR_DC_INITIAL_ProjectInfo_ExcelDevCopy where proj_id = " & value 
       conn.Execute stSQL 
       hasExecuted = True 
      End If 

     sql = "insert into dbo.STAR_DC_INITIAL_ProjectInfo_ExcelDevCopy (" 
     sql = sql & targetFieldNames 
     sql = sql & ") values (" & vbNewLine 

'

 'couldn't do transpose since rowData represents a row, not a column 
     For i = 1 To UBound(rowData, 2) 
      aField = Replace(rowData(1, i), "'", "''") 
       Select Case i 
        Case 1 To 40 
         sql = sql & "'" & aField & "', " & vbNewLine 
        Case 41 
         If aField Like "*,*" Then 
          sql = sql & "'" & """" & aField & """" & vbNewLine 
         Else 
          sql = sql & "'" & aField & "' " & vbNewLine 
         End If 
       End Select 


     Next i 

     sql = sql & ");" 
    ' sql = sql & "');" 

     conn.Execute sql 

     iRowNo = iRowNo + 1 

    Loop 

    conn.Close 
    Set conn = Nothing 

    End With 
End Sub