SF said:
Hi,
I have a database to track the photos of my projects. The projects
photo is saved in a specified directory. Since a project can have
many photos, I have set a standard naming as below
1 C:\PHOTOS\PROJECT1-001.JPG
2 C:\PHOTOS\PROJECT1-002.JPG
3 C:\PHOTOS\PROJECT1-003.JPG
AND SO ON...
Now I am confused with the last three figure that give the the file
name. I want to know the last available number through code so that I
don't have to go to that directory searching for them.
In my form, I have a combo for selecting the Project and a list box
to list all files name of the photos.
My question is how can I programmatically list the file name into the
listbox so that I can see the next available number .
SF
I don't know if you can adapt this easily to your purpose or not, but
here's the module code from a form I have used to list all files in a
specified folder that match a given pattern, and allow the user to
select one for further processing. The form has controls txtFolder,
txtPattern, txtAttributes, lstFiles, cmdOK, and cmdClose.
The function QSArray, which sorts the array, is something I found on the
'net -- I don't know the author.
'----- start of form module code -----
Option Compare Database
Option Explicit
Function FillFileList( _
fld As Control, _
ID As Variant, _
row As Variant, _
Col As Variant, _
code As Variant) _
As Variant
Static avarFiles(1000) As Variant
Static intEntries As Integer
Dim ReturnVal As Variant
ReturnVal = Null
Select Case code
Case acLBInitialize ' Initialize.
intEntries = 0
avarFiles(intEntries) = _
Dir(Me.txtFolder & "\" & Nz(Me.txtPattern, "*.*"),
CLng(Me.txtAttributes))
Do Until avarFiles(intEntries) = vbNullString _
Or intEntries >= 1000
intEntries = intEntries + 1
avarFiles(intEntries) = Dir
Loop
If intEntries > 1 Then
QSArray avarFiles, LBound(avarFiles), intEntries - 1
End If
ReturnVal = intEntries
Case acLBOpen ' Open.
' Generate unique ID for control.
ReturnVal = Timer
Case acLBGetRowCount ' Get number of rows.
ReturnVal = intEntries
Case acLBGetColumnCount ' Get number of columns.
ReturnVal = 1
Case acLBGetColumnWidth ' Column width.
' -1 forces use of default width.
ReturnVal = -1
Case acLBGetValue ' Get data.
ReturnVal = avarFiles(row)
Case acLBEnd ' End.
Erase avarFiles
End Select
FillFileList = ReturnVal
End Function
Private Sub QSArray(arrIn() As Variant, ByVal intLowBound As Integer,
ByVal intHighBound As Integer)
Dim intX As Integer
Dim intY As Integer
Dim varMidBound As Variant
Dim varTmp As Variant
If intHighBound > intLowBound Then
varMidBound = arrIn((intLowBound + intHighBound) \ 2)
intX = intLowBound
intY = intHighBound
Do While intX <= intY
If arrIn(intX) >= varMidBound And arrIn(intY) <= varMidBound Then
varTmp = arrIn(intX)
arrIn(intX) = arrIn(intY)
arrIn(intY) = varTmp
intX = intX + 1
intY = intY - 1
Else
If arrIn(intX) < varMidBound Then
intX = intX + 1
End If
If arrIn(intY) > varMidBound Then
intY = intY - 1
End If
End If
Loop
Call QSArray(arrIn(), intLowBound, intY)
Call QSArray(arrIn(), intX, intHighBound)
End If
End Sub
Private Sub cmdClose_Click()
DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
Private Sub cmdOK_Click()
If IsNull(Me.lstFiles) Then
MsgBox "You must choose a file first, or else click the Cancel
button."
Exit Sub
Else
Me.Visible = False
End If
End Sub
Private Sub Form_Open(Cancel As Integer)
Dim astrArgs() As String
Dim astrThisArg() As String
Dim i As Integer
astrArgs = Split(Trim(Me.OpenArgs & ""), "|", -1, vbBinaryCompare)
For i = LBound(astrArgs) To UBound(astrArgs)
astrThisArg = Split(astrArgs(i), "=", 2, vbBinaryCompare)
Select Case astrThisArg(0)
Case "Folder": Me.txtFolder = astrThisArg(1)
Case "Caption": Me.Caption = astrThisArg(1)
Case "Pattern": Me.txtPattern = astrThisArg(1)
Case "Attributes": Me.txtAttributes = astrThisArg(1)
Case "ChangeFolder": Me.FormHeader.Visible =
CBool(astrThisArg(1))
End Select
Next i
If Len(Me.txtFolder & vbNullString) = 0 Then
Me.txtFolder = CurDir
End If
If Len(Me.txtPattern & vbNullString) = 0 Then
Me.txtPattern = "*.*"
End If
' Having set all our initial properties, fill the list box with a
list
' of the matching files.
Me.lstFiles.RowSourceType = "FillFileList"
End Sub
Private Sub lstFiles_DblClick(Cancel As Integer)
' Double-clicking a file is the same as selecting the file
' and clicking the OK button.
Call cmdOK_Click
End Sub
Private Sub txtFolder_AfterUpdate()
Me.lstFiles.Requery
End Sub
Private Sub txtPattern_AfterUpdate()
Me.lstFiles.Requery
End Sub
'----- end of form module code -----
Of course, if you only want to know the next available number, you don't
really have to go to such lengths. You could just use the Dir()
function to loop through all the files in the folder that start with
[ProjectName] & "-", parse the trailing digits off the file name, keep
the maximum, and add 1 to it.
--
Dirk Goldgar, MS Access MVP
www.datagnostics.com
(please reply to the newsgroup)
