Update from an excel file - Help appreciated :)

[G1ZmO]

I'm trying to modify a VB script which does the following.
The purpose of this is to add items to an order.
When an excel file is selected the script reads the file and updates the SQL database for lines which match the ItemID by updating the sql Item table with the OrderID.
(it also checks the stockstatus of each ItemID to ensure that it has not already been sold)

[btw, I did not write the original script and the developer who did is no longer contactable. To be very honest I'm out of my depth with the methods he has used here so an explanation of what he has done and how to modify it would really be appreciated.]

What I need to do is include a SalePrice field in the excel file which also needs updated in the Item table.

The current VB stuff as follows:

Private Sub insertButton_Click()
    Dim addItemQuery As String
    Dim ItemID
    Dim findStockQuery
    Dim output
    Dim lngItemId
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim strWhere As String
    Dim itemIdColumn As Long
    Dim myExcel ' Variant rather than Excel types here to avoid linking to Excel version...
    Dim myWorksheet ' ...In case user machine does not have Excel.
    Dim r As Integer

    Me.Command0.Enabled = False
    Me.insertButton.Enabled = False
    DoEvents

    Set myExcel = CreateObject("Excel.Application")

    myExcel.Workbooks.Open excelFileName, True, True
    Set cn = OpenAdoDb()

    Set myWorksheet = myExcel.Workbooks(1).Worksheets(1)
    r = 2
    itemIdColumn = GetColumnIndex(myWorksheet, "ItemID")
    If itemIdColumn <> -1 Then
        While myWorksheet.Cells(r, 1).Value <> ""
            ItemID = myWorksheet.Cells(r, itemIdColumn)
            If ItemID <> "" Then
                addItemQuery = "SELECT Item.ID AS ItemId From Item WHERE ID = " & ItemID & " AND StockStatusID = 2"
                Set rs = cn.Execute(addItemQuery)
                If Not rs.EOF Then
                    lngItemId = rs.Fields("ItemId")
                    strWhere = "ID = " & CStr(lngItemId)
                    AddItemWhere strWhere
                End If
                rs.Close
            End If
    
            r = r + 1
        Wend
    Else
        MsgBox "No ItemID column found", vbExclamation, "Exception"
    End If
    
    RefreshParent
    CloseConnection cn
    myExcel.quit
    Set myExcel = Nothing
    DoCmd.Close acForm, Me.Name
End Sub

Private Sub RefreshParent()
    Forms!F_POs_Sales_WithParts.UpdateUI
End Sub

Public Sub AddItemWhere(ByVal strWhere As String)
    Dim lngStockStatusId As Long

    Dim strSQL As String

    On Error GoTo ErrorHandler

    lngStockStatusId = STOCK_STATUS_PENDING

    strSQL = "UPDATE Item Set OrderID = {0}, StockStatusID = {1} WHERE " & strWhere

    strSQL = ConstructQuery(strSQL, lngOrderId, lngStockStatusId)

    
    CurrentDb.Execute strSQL, dbSeeChanges
ErrorHandler:
    If Err.Number <> 0 Then
        MsgBox Err.Description, vbExclamation, "Add Item(s) - Error"
    End If
End Sub

 

[informer]

Hi G1ZmO

Modify your code as follows

Public Sub insertButton_Click()

dim SalePriceColNbr as long
SalePriceColNbr = Number for the SalePrice column in Excel worksheet

dim SalePrice as double

code...
While myWorksheet.Cells(r, 1).Value <> ""
    SalePrice =  myWorksheet.Cells(r , SalePriceColNbr).Value

....code...
    call AddItemWhere (strWhere , SalePrice )
   
End Sub

And for AddItemWhere function

Public Sub AddItemWhere(ByVal strWhere As String, ByVal  SalePrice as double)
...code..
strSQL = "UPDATE Item Set OrderID = {0}, StockStatusID = {1} , SalePrice  = " &  SalePrice  & " WHERE " & strWhere

...code...
End sub

Could you show the declartion for ConstructQuery function, please?

 

[G1ZmO]

Fantastic Informer, I will try this today and let you know how I get on.

The code for the ConstructQuery function is:

Public Function ConstructQuery(ByVal sql As String, ParamArray args() As Variant)
    Dim segments() As String
    Dim i, px, closeBrace As Integer
    Dim Result, s, v As String
    segments = Split(sql, "{")
    If LBound(segments) > UBound(segments) Then
        Result = ""
    Else
        Result = segments(LBound(segments))
        For i = LBound(segments) + 1 To UBound(segments)
            s = segments(i)
            closeBrace = InStr(1, s, "}")
            If closeBrace = 0 Then Err.Raise 93, , "No matching close brace"
            If closeBrace = 1 Then Err.Raise 93, , "Illegal parameter '{}'"
            px = CLng(left(s, closeBrace - 1))
            v = EscapeSQLValue(args(px))
            Result = Result _
                & v _
                & Mid(s, closeBrace + 1)
        Next i
    End If
    ConstructQuery = Result
End Function

 

[G1ZmO]

Informer, worked first time!
A HUGE thanks from me.

Don't suppose you can spare the time to explain it a little though?

Cheers