Display random image from folder (i.e. not embedded)

[opopanax666]

[SOLVED] Display random image from folder (i.e. not embedded)

Hello everyone,

I'm working on a database for my holiday pictures. The pictures are organized in folders per trip/date/location.

When viewing the data of a particular trip, I want the form to display a random image from the respective folder (path stored in database).

I already found a function to count the files in the folder:

Function GetFileCount(folderspec As String) As Integer
'  Returns a count of files in folderspec, or -1 if folder does not exist
   Dim fso As Object
   Set fso = CreateObject("Scripting.FileSystemObject")
   If fso.FolderExists(folderspec) Then
      GetFileCount = fso.GetFolder(folderspec).Files.Count
   Else
      GetFileCount = -1
   End If
End Function

to plug into a "randomizer":

lngFileCount = GetFileCount(strFOLDER)
Randomize
intRND = 1 + Int(lngFileCount * Rnd())
MsgBox intRND

The thing I can't find is how to reference this nth file (or even if there is a way to directly reference this file).

Is there, or do I have to use some kind of looping?

TIA for any feedback,
James

 

[pr2-eugin]

Hello opopanax666, I was just bored so am trying something different here.. What I would do is, just list all files in the Folder and select a Random Path.. Similar to your approach, just instead of having a Random Number.. We can have a Random Path from the directory..

I have designed the following function that will get you the Random Path..

The function uses the methods put forward by Allen Browne - "List Files Recursively". Please copy the functions FillDir and TrailingSlash from there..

Public Function getRandomPicturePath() As String
[COLOR=Green]'*******************************************************
'Code Courtesy of
'  Paul Eugin
'*******************************************************[/COLOR]
    Dim sampArr() As String, intRND As Long, lngFileCount As Long
    
    sampArr = [B][COLOR=Blue]ListFiles[/COLOR][/B]([COLOR=Red][B]"L:\Links\"[/B][/COLOR], "*.jpg", False)
[COLOR=Green]'The [/COLOR][COLOR=Green][B]path[/B] should be whatever you want it to be.. [/COLOR]
    
    lngFileCount = UBound(sampArr)
    intRND = 1 + Int(lngFileCount * Rnd())
    
    getRandomPicturePath = sampArr(intRND)
End Function

The ListFiles method is modified as..

Public Function ListFiles(strPath As String, Optional strFileSpec As String, _
    Optional bIncludeSubfolders As Boolean)[COLOR=Red][B] As String()[/B][/COLOR]
    
On Error GoTo Err_Handler
[COLOR=Green]    'Purpose:   List the files in the path.
    'Arguments: strPath = the path to search.
    '           strFileSpec = "*.*" unless you specify differently.
    '           bIncludeSubfolders: If True, returns results from subdirectories of strPath as well.
    '[/COLOR]
[COLOR=Green]    '[B]Code Author: Allen Browne[/B][/COLOR]
[COLOR=Green]    'Method:    FilDir() adds items to a collection, calling itself recursively for subfolders.[/COLOR]
    Dim colDirList As New Collection
[COLOR=Red][B]    Dim iCtr As Long, tmpArr() As String[/B][/COLOR]
    Dim varItem As Variant
    
    Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)
    
   [COLOR=Green] 'Add the files to a String Array.[/COLOR]
[B][COLOR=Red]    ReDim tmpArr(colDirList.Count)
    For Each varItem In colDirList
        tmpArr(iCtr) = varItem
        iCtr = iCtr + 1
    Next
    ListFiles = tmpArr[/COLOR][/B]
Exit_Handler:
    Exit Function

Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Exit_Handler
End Function

I have highlighted the changes to the code I have made.. The other functions remain the same.. Hope this helps.. Post back if you do not follow something..

 

[opopanax666]

Holy Tangent Thinking, Batman...

Thank you so much, Paul! Does exactly what I was looking for, not difficult to take it from here...

 

[pr2-eugin]

Ha ha, glad to help.. Good luck..