User Selects File to Update using ListBox1 on Form1 Version

[maic15]

I want the user to be able to select the file to update on there shared drive by selecting a value from listbox 1 on my form.
Currently, my code always updates: Const conWKB_NAME = "c:\temp\book1.xls".

How do I set Const conWKB_NAME = listbox1 value on form1?

Code:

Sub sCopyRSToNamedRange()
'Copy records to a named range
'on an existing worksheet on a
'workbook
'
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Const conMAX_ROWS = 20000
Const conSHT_NAME = "Sheet1"
Const conWKB_NAME = "c:\temp\book1.xls"
'Const conRANGE = "A7:C13"

Set db = CurrentDb
Set objXL = New Excel.Application
Set rs = db.OpenRecordset("Customers", dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)

'If Not Err.Number = 0 Then
For Index = 1 To 1
Set rs = db.OpenRecordset("Customers", dbOpenSnapshot)
objXL.Worksheets(Index).Range("A7,C13").CopyFromRecordset rs
Next

For Index = 2 To 2
Set rs2 = db.OpenRecordset("query2", dbOpenSnapshot)
objXL.Worksheets(Index).Range("k13,C13").CopyFromRecordset rs2
Next
For Index = 3 To 3
Set rs3 = db.OpenRecordset("tblprocedure", dbOpenSnapshot)
objXL.Worksheets(Index).Range("j7,C13").CopyFromRecordset rs3
Next

Err.Clear

On Error GoTo 0


End With



Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing

End Sub

 

[mdmilner]

Re: User Selects File to Update using ListBox1 on Form1 Ver

Easily done. I actually prefer to use table values to do something similar.
Aka, after the user selects a value in a list box, the after_update event triggers and writes a value to a table. The code then reads that value.

Advantage to this is, the table value is permanent until changed/deleted. If you shut down the database and reopen, it'll remember the last value selected.
-
To answer your question specifically, here is how you would reference a value in a listbox (format) from a VBA module (not the module attached to the form)

Forms!frmName.lboName.Value

Inside the forms code module you can shorten that to:

Me.lboName.Value

You could hardcode that value into your code substituting the form name and listbox name for yours.
-
And now for my approach.
Create a table (tblDefaults) I currently have 4 fields in mine.
UserName, TypeOfDefault, DefaultInfo, Comments

Really only the 2nd/3rd columns are critical for your use.

Into the listboxes after_update event, insert something like:

Call SetDefaults("LastBucket", Me.lboBucket.Value, 2)

The function call would be to something like:

Public Function SetDefaults(MyDefaults As String, strEntry As String, _
                            strMod As Integer, Optional strOption As String)
Dim dbs As DAO.Database
Dim rs As DAO.Recordset

Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("Select * from tblDefaults", dbOpenDynaset)

     With rs
        .FindFirst "TypeOfDefault='" & MyDefaults & "'"
        If !TypeOfDefault = MyDefaults Then
           .Edit
           .Fields(strMod).Value = strEntry
           .Update
        Else         'If can not find it, create a new one
           .AddNew
           .Fields(1).Value = MyDefaults
           .Fields(strMod).Value = strEntry
           .Update
        End If
     End With

Set rs = Nothing
Set dbs = Nothing

End Function

Inside your actual function that wants the full path to the file, you put something like:

Public Function FindDefaults(ByVal MyDefaults As String) As String

Dim dbs As DAO.Database
Dim rst As DAO.Recordset

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Select * from tblDefaults", dbOpenSnapshot)

With rst
    .FindFirst "TypeOfDefault='" & MyDefaults & "'"
    If !TypeOfDefault = MyDefaults Then
        FindDefaults = !DefaultInfo
    Else
        MsgBox MyDefaults & " Information Not Found"
    End If
End With

Set rst = Nothing
Set dbs = Nothing

Which you would call using code like:

FindDefaults("LastBucket")

Substitute your own unique names and actual control names.

Mike