Here is another unique question for the experts. :D

I have a field in a table which has a file name "some.jpg". I also have a directory which has about 7000 images. I'm looking for a way that I can compare the names in the access table to the names in the directory and for the ones that don't exist copy a standard jpg file for the ones that don't exist to the name in the database.

Essentially what this will be doing is taking a jpg file which has a "no-image available" icon and creating a new file for all those items in the database that don't have an associated image.

Is this possible? Any examples would be great or point me in the right direction.

Thanks,
Neil

Neil

Hi Neil,

First off, welcome to the forum - you'll find it a great resource, and a place to share your wisdom with the rest of us!

I have some code that does the reverse of this. I have been working on building an index of images in a folder, and doing rename type stuff with them too. This steer you in the right direction...

The idea was to find all files that don't have _thu.jpg as the last 8 characters.

Mike

Mike
EchoVue.com

Thanks for the welcome.

I think I'm close. How would I copy a file within the code?

I want to a file copy of E:\My Image\NoImage.jpg to (variable).jpg

Neil

I believe the line you would want would be...


Mike
EchoVue.com

Here is where I'm at this will all work if I could remember/figure out how to return the value of the recordset for comparison. The red text is the only part I think I'm lacking and for the life of me can't find what I'm looking for. Maybe it's lack of sleep.



Function createimages()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim strWhereClause As String
    strDirFilenameCompare = ""
    Set db = CurrentDb

    Path = "E:\My Documents\Product Images Desc PDFs\test"
    NoImageFile = "E:\My Documents\Product Images Desc PDFs\test\NO_IMAGE.jpg"

    With Application.FileSearch
        .LookIn = Path
        .SearchSubFolders = False
        .fileName = "*.jpg"
        .Execute msoSortByFileName
    End With

    If Application.FileSearch.FoundFiles.Count = 0 Then
        MsgBox "No Files Found"
        Exit Function
    End If

    Set rst = db.OpenRecordset("SELECT tbl_master_pricing.v_products_image FROM tbl_master_pricing;")

    rst.MoveFirst
    strDirFilenameCompare = ""

    image_file_rec = CURRENT RECORD IN RECORDSET

    NewFile = Path & "\" & image_file_rec
    CreateFile = 1

    For Counter = 1 To Application.FileSearch.FoundFiles.Count
    file = Application.FileSearch.FoundFiles.Item(Counter)
    strDirFilenameCompare = Trim((Mid(Application.FileSearch.FoundFiles.Item(C ounter), 96, 50)))
    If image_file_rec = strDirFilenameCompare Then CreateFile = 0
    Next

    If CreateFile = 1 Then FileCopy NoImageFile, NewFile And FileCreate = FileCreate + 1 Else MsgBox "No Image Created"

    rst.MoveNext

    rst.Close
    MsgBox (FileCreate & " files created.")
End Function


Neil

Sleep did me good. I'm glad I figured out the stupid question before someone responded :D

Here is a copy of the final working script. It created 3,558 missing files in about 5 minutes!! Great!! Thanks for getting me started in the right direction.

Now is there anyway to FTP these files to an external server as they are created? That would be really cool. Then all I have to do is set this to run and walk away.


WORKING CODE:

Function createimages()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim strWhereClause As String
    strDirFilenameCompare = ""
    Set db = CurrentDb

    Path = "E:\My Documents\xxxxx xxxxx's Documents\xxxxx Distribution Files\Product Images Desc PDFs\JPGs"
    NoImageFile = "E:\My Documents\xxxxx xxxxx's Documents\xxxxx Distribution Files\Product Images Desc PDFs\JPGs\NO_IMAGE.jpg"

    With Application.FileSearch
        .LookIn = Path
        .SearchSubFolders = False
        .fileName = "*.jpg"
        .Execute msoSortByFileName
    End With

    If Application.FileSearch.FoundFiles.Count = 0 Then
        MsgBox "No Files Found"
        Exit Function
    End If
' Get record set of database image names
    Set rst = db.OpenRecordset("SELECT tbl_master_pricing.v_products_image FROM tbl_master_pricing;")
    rst.MoveFirst
    strDirFilenameCompare = ""
    Set v_image_file = rst![v_products_image]
    NewFile = Path & "\" & v_image_file
' Set flag to creat a new file
    CreateFile = 1
    Do Until rst.EOF
' Compare Database image name to all files in directory to see if it exists
    For Counter = 1 To Application.FileSearch.FoundFiles.Count
    file = Application.FileSearch.FoundFiles.Item(Counter)
    strDirFilenameCompare = Trim((Mid(Application.FileSearch.FoundFiles.Item(C ounter), 96, 50)))
    If v_image_file = strDirFilenameCompare Then
    CreateFile = 0
    Counter = Application.FileSearch.FoundFiles.Count
    End If
    If v_image_file Like "*/*" Then CreateFile = 0
    Next
' If Database image name does not exist create a copy of the no_image.jpg for the item
    If CreateFile = 1 Then
     FileCopy NoImageFile, NewFile
     FileCreate = FileCreate + 1
    End If
' Reset Variables and loop to next record
    CreateFile = 1
    rst.MoveNext
    Set v_image_file = rst![v_products_image]
    If rst.EOF = False Then NewFile = Path & "\" & v_image_file
    strDirFilenameCompare = ""
    Loop
    rst.Close
    MsgBox (FileCreate & " files created.")
End Function

Neil

Hi Neil,

Good to hear you figured it out. I saw your posting last night right before I logged out, but I was in the same "sleep deprived" state of mind, and so probably would have led you further down the wrong path.

I'll let you know if I find anything out on using FTP from within VBA. I could actually use something like this myself.

See ya,

Mike

Mike
EchoVue.com

to use FTP from Acces check out:

http://www.mvps.org/access/modules/mdl0015.htm

and

http://www.mvps.org/access/modules/mdl0037.htm



Boyd
"Hi Tech Coach"
Access Based Accounting/Business Solutions developer.
http://www.officeprogramming.com