Results 1 to 6 of 6
  1. #1
    Join Date
    Feb 2009
    Posts
    37

    Unanswered: adjusting VB script

    I have the following script to append a selection from a multi select list box to a table.

    Code:
    Option Compare Database
    Option Explicit
    Private Sub cmdOK_Click()
    On Error GoTo Err_Handler
    ' Declare variables
    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim varItem As Variant
    Dim strCriteria As String
    Dim strSQL As String
    ' Get the database and stored query
    Set db = CurrentDb()
    Set qdf = db.QueryDefs("qryDogsSelected")
    ' Loop through the selected items in the list box and build a text string
    If Me!lstDogIDs.ItemsSelected.Count > 0 Then
    For Each varItem In Me!lstDogIDs.ItemsSelected
    strCriteria = strCriteria & "Dogs.DogID = " & Chr(34) _
    & Me!lstDogIDs.ItemData(varItem) & Chr(34) & "OR "
    Next varItem
    strCriteria = Left(strCriteria, Len(strCriteria) - 3)
    Else
    MsgBox "Must Select An Item From The List First"
    Exit Sub
    End If
    ' Build the new SQL statement incorporating the string
    strSQL = "INSERT INTO DogsatSighting ( DogID ) " & _
    "SELECT Dogs.DogID FROM Dogs " & _
    "WHERE " & strCriteria & ";"
    ' Apply the new SQL statement to the query
    qdf.SQL = strSQL
    ' Open the query
    DoCmd.SetWarnings False
    DoCmd.OpenQuery "qryDogsSelected"
    DoCmd.SetWarnings True
    ' Empty the memory
    Set db = Nothing
    Set qdf = Nothing
    
    Exit_Handler:
    Exit Sub
    The query selects the DogIDs which are appended to the the table DogsatSighting, this works fine.

    But I also like to save the event (the SightingID) at which they are seen.
    So I wrote a new appendquery (say 'new query') to append both the selected SightingID and DogID to the table DogsatSitghting.

    The new append query:

    Code:
    INSERT INTO DogsatSighting ( DogID, SightingID )
    SELECT Dogs.DogID, Sightings.SightingID
    FROM Dogs, Sightings
    (((Sightings.SightingID)=[Sighting]) AND ((Dogs.Current)=[Pack seen]));
    Now I have to make some adjustments to the VB script. But I get lost in this, I assume I have to change the name of 'qryDogsSelected' to the name of the new append query.
    I assume I have to adjust the INSERT INTO part in the VBScript to something like:
    Code:
    strSQL = "INSERT INTO DogsatSighting ( DogID SightingID ) " & _
    "SELECT Dogs.DogID Sighting.SightingID FROM Dogs Sighting " & _
    "WHERE " & strCriteria & ";"
    But should something change in the last line as well?

    At last I think something should change in this part, but I have no clue how to do that.
    Code:
    ' Loop through the selected items in the list box and build a text string
    If Me!lstDogIDs.ItemsSelected.Count > 0 Then
    For Each varItem In Me!lstDogIDs.ItemsSelected
    strCriteria = strCriteria & "Dogs.DogID = " & Chr(34) _
    & Me!lstDogIDs.ItemData(varItem) & Chr(34) & "OR "
    Next varItem
    strCriteria = Left(strCriteria, Len(strCriteria) - 3)
    I hope somebody can help me out on this!

  2. #2
    Join Date
    Feb 2009
    Posts
    37
    Any help/comments on this, please?

  3. #3
    Join Date
    Dec 2004
    Location
    Madison, WI
    Posts
    3,926
    I don't think you mean VB script but instead mean VBA coding (unless you are actually creating a separate vb script file which isn't exactly MSAccess/vba coding.)

    I hate to just direct you to the MSAccess code bank but there's several examples there which I'm pretty sure would help you with what you're trying to do, especially ones which show examples of walking through listboxes which have multi-select on and building SQL statements off of selected items.

    Otherwise I'm confused at what you're asking and what you're trying to do and without knowing your db, it's difficult to guess.

    This...
    strSQL = "INSERT INTO DogsatSighting ( DogID SightingID ) " & _
    "SELECT Dogs.DogID Sighting.SightingID FROM Dogs Sighting " & _
    "WHERE " & strCriteria & ";"

    should probably be based more of off information from the form versus off of stCriteria but again, I don't know your mdb. Perhaps a sample upload might help us to help you.
    Last edited by pkstormy; 02-28-09 at 22:54.
    Expert Database Programming
    MSAccess since 1.0, SQL Server since 6.5, Visual Basic (5.0, 6.0)

  4. #4
    Join Date
    Feb 2009
    Posts
    37
    Here's an example of my mdb, I've looked into the MSAccess Code Bank, but haven't found an example yet similar enough to my problem for me to understand.

    The mdb was missing but it can be found here.
    Last edited by VB noob; 03-02-09 at 06:06.

  5. #5
    Join Date
    Dec 2002
    Location
    Préverenges, Switzerland
    Posts
    3,740
    user must first select a sightingID, then multiselect the dogs sighted.
    let's imagine that sightingID (numeric, long, auto) is the boundcolumn of a combo cboSightingID.
    and that dogID (string) is the boundcolumn of the multiselect list lstDogIDs.

    from there, maybe this works:
    Code:
    dim strSQL as string
    dim varItem as variant
    dim unmatched as long
    dim inserted as long
    
    unmatched = DCOUNT("DogID", "DogsAtSighting", "SightingID is null") 
    if unmatched > 0 then
    	msgbox "We have " & unmatched & " records with sightingID missing from earlier updates - killing them."
    	strSQL = "DELETE * FROM DogsAtSighting WHERE SightingID is null"
    	currentdb.execute strSQL
    endif
    
    strSQL = "INSERT INTO DogsAtSighting(DogID) VALUES('"
    For Each varItem In Me!lstDogIDs.ItemsSelected
    	' WRONG strSQL = strSQL & me!lstDogIDs.column(varItem) & "', '" 
            strSQL = strSQL & me!lstDogIDs.column(zeroBasedIndexOfTheDogIDcolumn, varItem) 'CORRECTION
    next
    strSQL = left$(strSQL, len(strSQL)-3) & ")"
    currentdb.execute strSQL
    
    inserted = DCOUNT("DogID", "DogsAtSighting", "SightingID is null")
    
    strSQL = "UPDATE DogsAtSighting SET sightingID = " & me.cboSightingID & " WHERE sightingID is null"
    currentdb.execute strSQL
    
    unmatched = DCOUNT("DogID", "DogsAtSighting", "SightingID is null")
    if unmatched  > 0 then
    	msgbox "We have " & unmatched & " updated records with sightingID missing - undoing this update."
    	strSQL = "DELETE * FROM DogsAtSighting WHERE SightingID is null"
    	currentdb.execute strSQL
    else
    	msgbox "Inserted " & inserted & " new Dog:sighting pairs"
    endif
    you could roll it all up into one INSERT doing both the dogID and sightingID, but that's a lot of repeated text.

    izy

    LATER: error fixed inline in the above code
    Last edited by izyrider; 03-01-09 at 14:12.
    currently using SS 2008R2

  6. #6
    Join Date
    Feb 2009
    Posts
    37
    Thanks, much appreciated! I'll try this.
    But I'm travelling to Africa the coming days only reaching my destination by Tuesday night, then probably a couple of days of organizing stuff before I can get to this.
    So I might get back to you if I have some more question but it'll take some time.
    Thanks for your time.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •