Shared file locks for saving when a specific macro is run

[Sleepyshy]

Good Morning,

I have created a database in excel that is to be in a public shared folder. When it is not shared you can run all of the macro's just fine and everything is all fine and dandy. As soon as it gets shared, and you use the "Update Drop Downs" macro, it locks the document for saving. all of the macro's still work which is good but you just can't save after the fact. I figure that it is because I use some mySQL in the excel code and it opens the excel document partially (I am just throwing stones into the pond at this point) and since excels sees it as "Opening" it locks the file for editing. Does anyone know a work around for this? I was thinking maybe closing the background file that is open some how but I am not sure what the vba would be for that.

I tried having the program close then reopen before I let the user input data for saving but sharing cut that off and errored so I am out of ideas.

I have attached the file for you to look at:

InventoryDatabase.xlsm

If you have any questions at all let me know,
Sleepyshy

[Sleepyshy]

UPDATE!

Hello again,

I have found the solution to my own problem! I found that all I had to do was insert this teeny weeny bit of code in the following places:

End

Private Sub cmdUpdateDropDowns_Click()
    strSQL = "Select Distinct [Item] From [data$] Order by [Item]"
    closeRS
    OpenDB
    cmbProducts.Clear
    
    rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
    If rs.RecordCount > 0 Then
        Do While Not rs.EOF
            cmbProducts.AddItem rs.Fields(0)
            rs.MoveNext
        Loop
    Else
        MsgBox "I was not able to find any unique Products.", vbCritical + vbOKOnly
        Exit Sub
    End If
    
    '----------------------------
    strSQL = "Select Distinct [ID#] From [data$] Order by [ID#]"
    closeRS
    OpenDB
    cmbID.Clear
    
    rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
    If rs.RecordCount > 0 Then
        Do While Not rs.EOF
            cmbID.AddItem rs.Fields(0)
            rs.MoveNext
        Loop
    Else
        MsgBox "I was not able to find any unique Region(s).", vbCritical + vbOKOnly
        Exit Sub
    End If
End
End Sub

Private Sub cmdShowData_Click()
Dim intSQL As Integer

    'populate data
    strSQL = "SELECT * FROM [data$] WHERE "
    If cmbProducts.Text <> "" Then
        strSQL = strSQL & " [Item]='" & cmbProducts.Text & "'"
    End If
    
    If cmbID.Text <> "" Then
        If cmbProducts.Text <> "" Then
            strSQL = strSQL & " AND [ID#]='" & cmbID.Text & "'"
        Else
            strSQL = strSQL & " [ID#]='" & cmbID.Text & "'"
        End If
    End If
    
    If cmbProducts.Text <> "" Or cmbID.Text <> "" Then
        'now extract data
        closeRS
        
        OpenDB
        
        rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic
        If rs.RecordCount > 0 Then
            Sheets("Search").Visible = True
            Sheets("Search").Select
            Range("dataSet").Select
            Range(Selection, Selection.End(xlDown)).ClearContents
            
            'Now putting the data on the sheet
            ActiveCell.CopyFromRecordset rs
        Else
            MsgBox "I was not able to find any matching records.", vbExclamation + vbOKOnly
            Exit Sub
        End If
    End If
End
End Sub

If anyone doesn't get it let me know!
Have a great day,
Sleepyshy