?
Solved

Show files in directory that do not have related # in DB

Posted on 2005-03-21
29
Medium Priority
?
261 Views
Last Modified: 2008-03-06
I have a Sub and query that will show me any ProductNumbers from tblWarehouseInvDaily that do not have a matching .jpg file in a specific directory.  I will post the existing code I have for the Sub & query just mentioned, but here is what I would like to do:

I need to reverse the above so that it shows .jpgs in \\server\directory that do not have a matching ProductNumber in tblWarehouseInvDaily.

The product number and image name are not exact matches.  We have to pull the first 8 characters from the Product Number and that is the name of the .jpg.

IE:

R32300754

The .jpg would be named R3230075.jpg

Here is the code I have that shows ProductNumbers without images in \\servername\directory.

-------------------------------------------------------------------------------------------------------------------------------------

Private Sub cmdProductsWOImages_Click()
On Error GoTo Err_cmdProductsWOImages_Click
    Dim strsql As String
    Dim strFileName As String
   
    'build directory
    strFileName = "c:\ProductsWithoutImages.xls"
   
    If Len(Dir(strFileName)) > 0 Then
       Kill strFileName
    End If
   

    'build SQL
    strsql = "SELECT * FROM qselImagesNotInDailyInventory"
   
    'export query
    DoCmd.TransferSpreadsheet TransferType:=acExport, _
                              SpreadsheetType:=acSpreadsheetTypeExcel9, _
                              Tablename:="qselImagesNotInDailyInventory", _
                              FileName:=strFileName, _
                              HasFieldNames:=False
    'excel variables
    Dim xlApp As Excel.Application
    Set xlApp = New Excel.Application
    xlApp.Visible = True
    xlApp.Workbooks.Open strFileName
    xlApp.Cells.Select
    With xlApp.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    xlApp.Cells.EntireColumn.AutoFit
    xlApp.Rows("1:1").Select
    xlApp.Selection.Font.Bold = True
    xlApp.Cells.Select
    xlApp.Cells.EntireColumn.AutoFit
    xlApp.ActiveWindow.SplitRow = 0.941176470588235
    xlApp.ActiveWindow.FreezePanes = True
    xlApp.Range("A1").Select
    xlApp.Columns("B:B").Select
    xlApp.Selection.Insert Shift:=xlToRight
    xlApp.Columns("A:A").Select
    xlApp.Selection.TextToColumns Destination:=xlApp.Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(8, 1))
    xlApp.Columns("B:B").Select
    xlApp.Selection.ClearContents
    xlApp.Range("B2").Select
    xlApp.ActiveCell.FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],""DELETE"",""OK"")"
    xlApp.Range("B2").Select
    xlApp.Selection.AutoFill Destination:=Range("B2:B10000")
    xlApp.Range("B2:B10000").Select
    xlApp.Range("B1").Select
    xlApp.ActiveCell.FormulaR1C1 = "STATUS"
    xlApp.Range("B1").Select
    xlApp.Selection.AutoFilter
    xlApp.Selection.AutoFilter Field:=2, Criteria1:="DELETE"
    xlApp.Cells.Select
    xlApp.Range("B1").Activate
    xlApp.Selection.ClearContents
    xlApp.Cells.Select
    xlApp.Selection.Sort Key1:=xlApp.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    xlApp.ActiveWindow.SmallScroll Down:=-63
    xlApp.Range("B1").Select
    xlApp.ActiveCell.FormulaR1C1 = "OK"
    xlApp.Range("B2").Select
    xlApp.ActiveWindow.FreezePanes = False
    xlApp.ActiveWindow.SplitRow = 0
    xlApp.Range("A1").Select
    xlApp.ActiveWindow.SmallScroll Down:=-87
    xlApp.Columns("B:B").Select
    xlApp.Selection.Delete Shift:=xlToLeft
    xlApp.Columns("C:C").Select
    xlApp.Selection.Delete Shift:=xlToLeft
    xlApp.Range("A1").Select
    xlApp.ActiveWindow.SmallScroll Down:=-15
    xlApp.Range("A1").Select
   
    xlApp.ActiveWorkbook.Save
    Set xlApp = Nothing
Exit_cmdProductsWOImages_Click:
On Error Resume Next
    If Not (xlApp Is Nothing) Then xlApp.Close: Set xlApp = Nothing
Exit Sub
Err_cmdProductsWOImages_Click:
        MsgBox Err.Description, , "Error in Sub frmSalesCustomerServiceReports.cmdProductsWOImages_Click"
        Resume Exit_cmdProductsWOImages_Click
    Resume 0    '.FOR TROUBLESHOOTING
End Sub
-------------------------------------------------------------------------------------------------------------------------------------

This is the query.


SELECT tblWarehouseInvDaily.ProductNumber, tblWarehouseInvDaily.ProductDescription, IIf(Len(Dir("\\atlapcapps\OIS\Images\" & Left$(CStr([ProductNumber]),8) & ".jpg"))=0,"Missing","Found") AS PicStatus
FROM tblWarehouseInvDaily
WHERE (((tblWarehouseInvDaily.ProductNumber) Like "R*") AND ((IIf(Len(Dir("\\atlapcapps\OIS\Images\" & Left$(CStr([ProductNumber]),8) & ".jpg"))=0,"Missing","Found"))="Missing"));



Thanks,

Jeremy
0
Comment
Question by:Jeremyw
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 12
  • 12
  • 5
29 Comments
 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 13594170
You can't do it with a query - you'd need some code like this:

Dim strFile As String

strFile=Dir("\\server\directory\*.jpg")
While strFile<>""
   If IsNull(DLookUp("[ProductNumber]","blWarehouseInvDaily","[ProductNumber]=" & Left$(strFile,Len(strFile)-4))) Then
      'strFile at this point contains the name of a jpg without a matching record, you can perform an operation with it
   End If
   strFile=Dir()
Wend
0
 
LVL 51

Assisted Solution

by:Steve Bink
Steve Bink earned 400 total points
ID: 13594176
Public Sub ImagesWOProducts()
' You can change this into an event on a command button also...
' This sub assumes you have a table called "MyTempTable" to which the results will be written.

Dim sSQL as String
Dim sFile as String

sFile = Dir("\\server\directory\*.jpg")

While sFile <> ""
    If IsNull(DLookup("ProductNumber", "tblWarehouseInvDaily", "ProductNumber LIKE '" & Left(sFile, Instr(1, sFile, ".") - 1) & "*'") Then
        CurrentDB.Execute "INSERT INTO MyTempTable (FileName) VALUES ('" & sFile & "')"
    End If
    sFile = Dir()
Wend

End Sub
0
 
LVL 51

Expert Comment

by:Steve Bink
ID: 13594185
Shane, you're bumbling about in my head again!
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 13594208
I never bumble.
0
 
LVL 3

Author Comment

by:Jeremyw
ID: 13594905
routinet's is working like expected.  Very slow, but it's working.  :)  There are 3500 + .jpgs in the images folder and 6300+ Product Numbers in tblWarehouseInvDaily.

Shane,

There are other .jpgs in the images folder that do not have the same naming format.  For instance, aa.jpg, aalogo.jpg, etc.  when you're code got to the first one (aa.jpg), it caused a run-time error.  2417?  I think.  Once routinet's is finished running, I will run your code again and give you the exact error, if you'd like.

Thanks,

Jeremy
0
 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 13594959
There's actually an error in my statement. Where it says:

If IsNull(DLookUp("[ProductNumber]","blWarehouseInvDaily","[ProductNumber]=" & Left$(strFile,Len(strFile)-4))) Then

it should say:
If IsNull(DLookUp("[ProductNumber]","blWarehouseInvDaily","[ProductNumber]='" & Left$(strFile,Len(strFile)-4) & "'")) Then
0
 
LVL 3

Author Comment

by:Jeremyw
ID: 13595086
Is there much difference between your's and routinet's?  

I'm still waiting on routinet's to finish running.  We're going on 15+ minutes now.  With the amount of images & records posted above, do you think it should be taking this long?

0
 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 13595125
There's no difference at all except that mine does an exact match on the filename while routinet's does a partial match. An exact match will be faster, but maybe not that much faster, it depends on your data.
0
 
LVL 3

Author Comment

by:Jeremyw
ID: 13595161
An exact match wouldn't work.  The .jpg name is actually the first 8 characters of the Product Name.

For example.

I have product numbers
R32300754
R32300755
R32300756
R32300757

All of these product numbers use the same .jpg.  R3230075.jpg

That's why i need it to only do a partial on the 1st 8 characters and then .jpg.
0
 
LVL 51

Expert Comment

by:Steve Bink
ID: 13595229
Well, there's A LOT of files and data to check.  You have to realize that this is pulling 1 query, in some cases two, for EVERY filename: one to check the table data, and one to INSERT the find, if necessary.  I can probably optimize the code a bit to run the data check from one open recordset, but I could not guarantee a great performance boost from it.
0
 
LVL 3

Author Comment

by:Jeremyw
ID: 13595507
If it's going to take a while :), instead of inserting into a table, what about just deleting the file or moving the file to a "archive" subfolder.  from \\servername\images to \\servername\images\archive\

instead of CurrentDB.Execute "INSERT INTO MyTempTable (FileName) VALUES ('" & sFile & "')"

could I just use

Kill sFile

What about if I wanted to move the file?


With the amount of time this is taking, would a progress bar work in this situation, or would it cause more problems?  I've never dealt with progress bars before & i'll post another question if it will work.

Thanks,

Jeremy
0
 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 13595528
How many records are there in your tblWarehouseInvDaily table?
0
 
LVL 3

Author Comment

by:Jeremyw
ID: 13595556
There are 3500  .jpgs in the images folder and 6300 Product Numbers in tblWarehouseInvDaily.
0
 
LVL 51

Expert Comment

by:Steve Bink
ID: 13595582
You can always make a progress bar work during the loop...in fact, I'd probably recommend it since it is taking such a long time.  The other option is to replace the use of the DLookup (the speed culprit in this case) with a persistent recordset that is searched with each iteration of the loop.  It would be faster, but you still have all these records and files to sort through, so I would not expect a solution that runs in less than a couple minutes.

Deleting or moving the file is not likely to increase this much.  Deleting the file would probably take as much time as the INSERT (if not more), and copying/moving the file would definitely cause some additional overhead and a performance hit.
0
 
LVL 41

Accepted Solution

by:
shanesuebsahakarn earned 1600 total points
ID: 13595598
Just out of interest, try this - create a table called tblFiles with two fields (ID - Autonumber, Filename - Text). Run this code:

Dim strFile As String
Dim rst As DAO.Recordset

CurrentDb.Execute "DELETE * FROM tblFiles"
Set rst=CurrentDb.OpenRecordset("tblFiles")
strFile=Dir("\\server\directory\*.jpg")
While strFile<>""
   rst.AddNew
   rst!Filename=strFile
   strFile=Dir()
Wend
rst.Close
Set rst=Nothing

How quickly does it run?
0
 
LVL 3

Author Comment

by:Jeremyw
ID: 13595648
It runs immediately, but nothing is added to tblFiles.
0
 
LVL 51

Expert Comment

by:Steve Bink
ID: 13595671
Make this change:

rst.AddNew
rst!Filename = strFile
rst.Update    '<--- This line
strFile = Dir()
0
 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 13595675
Whoops, needs this just before the Wend line:

rst.Update
0
 
LVL 3

Author Comment

by:Jeremyw
ID: 13595922
ok,

that is definitely a lot faster (almost instant), but it inserts every image from the images folder to the tblFiles table.

Remember, it is not an exact match.  it needs to only pull the 1st 8 characters from the .jpg name
0
 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 13595963
Yes, that's what we need. Now that the data is in the table, run this query:

SELECT * FROM tblFiles WHERE NOT EXISTS (SELECT ProductNumber FROM tblWarehouseInvDaily WHERE Left$([ProductNumber],8)=Left$(tblFiles.Filename,8))

Does that work?
0
 
LVL 3

Author Comment

by:Jeremyw
ID: 13596021
Ahhh.

That looks like that has it.

What about moving those files to a sub-directory?  If that's too difficult, I can just delete the files........but how would I do that now?
0
 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 13596050
To delete or rename the files, you would need code like this (this assumes the above query is saved as qryUnmatched):

Dim rst As DAO.Recordset

Set rst=CurrentDb.OpenRecordset("tblFiles")
While Not rst.EOF
   Kill "\\server\directory\" & rst!Filename      'This line deletes
   Name "\\server\directory\" & rst!Filename As "\\server\directory\subdirectory\" & rstFilename        'This line renames
   rst.MoveNext
Wend
rst.Close

Just use whichever line you need within the While loop.
0
 
LVL 3

Author Comment

by:Jeremyw
ID: 13596153
Is it missing a reference to the query?

When I ran this, it moved everything from folder A to folder B
0
 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 13596179
D'oh!

This line:
Set rst=CurrentDb.OpenRecordset("tblFiles")

should read:
Set rst=CurrentDb.OpenRecordset("qryUnmatched")
0
 
LVL 3

Author Comment

by:Jeremyw
ID: 13596226
Is this what the final should look like so it pulls any files first and then looks at qryUnmatched?

Public Function ImageTest()
Dim strFile As String
Dim rst As DAO.Recordset

CurrentDb.Execute "DELETE * FROM tblFiles"
Set rst = CurrentDb.OpenRecordset("tblFiles")
strFile = Dir("\\atlapcapps\ois\images\*.jpg")
While strFile <> ""
rst.AddNew
rst!Filename = strFile
strFile = Dir()
rst.Update    '<--- This line
Wend

Set rst=CurrentDb.OpenRecordset("qryUnmatched")
While Not rst.EOF
   Name "\\server\directory\" & rst!Filename As "\\server\directory\subdirectory\" & rstFilename        'This line renames
   rst.MoveNext
Wend

rst.Close

Set rst = Nothing
End Function
0
 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 13596237
Yep, that looks pretty much right.
0
 
LVL 3

Author Comment

by:Jeremyw
ID: 13596253
Is there anything I can do to keep it from moving these files?

aa.jpg
aanoimage.jpg
jhlogo.jpg
oisheader.jpg
oislogo.jpg
0
 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 13596297
Hmm, you could check to see if the JPG name is twelve characters long ("R"+7 numbers+".jpg") in total and starts with an R I guess - try changing this part:
While strFile <> ""
rst.AddNew
rst!Filename = strFile
strFile = Dir()
rst.Update
Wend

to:
While strFile <> ""
If Len(strFile)=12 And Left$(strFile,1)="R" Then
   rst.AddNew
   rst!Filename = strFile
   rst.Update
End If
strFile = Dir()
Wend
0
 
LVL 3

Author Comment

by:Jeremyw
ID: 13596350
PERFECT!!!!!!

Thanks all.

Keep an eye out tomorrow for the progress bar Q that will relate to this.  

I've had enough for today  :)

Thanks again.

Jeremy
0

Featured Post

Three Reasons Why Backup is Strategic

Backup is strategic to your business because your data is strategic to your business. Without backup, your business will fail. This white paper explains why it is vital for you to design and immediately execute a backup strategy to protect 100 percent of your data.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes two methods for creating a combo box that can be used to add new items to the row source -- one for simple lookup tables, and one for a more complex row source where the new item needs data for several fields.
AutoNumbers should increment automatically, without duplicates.  But sometimes something goes wrong, and the next AutoNumber value is a duplicate.  This article shows how to recover from this problem.
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …
Suggested Courses

800 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question