You are here:

Excel/adding images to a database using file times

Advertisement


Question
QUESTION: Excel 2010

Several months ago you helped me inserting license plate (LPs) images into an excel database. Below is the script that you supplied and I modified:

Sub checkfiles()
Dim sPath As String, sName As String
Dim sFirst As Boolean, rw As Long
Dim pic As Picture
Dim r As Range
sFirst = True
rw = 1
sPath = "C:\1. LP software\0. lpfinder\"
'sPath = "D:\C_Drive\Data\"
sName = Dir(sPath & "*.jpg")
Do While sName <> ""
If sFirst Then
   Set r = Cells(rw, 1)
   r.Value = sName
   r.VerticalAlignment = xlBottom  ' text at the bottom
'    r.HorizontalAlignment = xlCenter
   Set pic = ActiveSheet.Pictures.Insert(sPath & sName)
   pic.ShapeRange.LockAspectRatio = False
   pic.Top = r.Top   ' Picture at the top
   pic.Left = r.Left
   'Column A, image does not need to be reduced
   pic.Height = 80
   pic.Width = 109
   pic.OnAction = "PicAction1"
   sFirst = False
Else
   
   Set r = Cells(rw, 2)
   r.Value = sName
   r.VerticalAlignment = xlBottom  ' text at the bottom
'    r.HorizontalAlignment = xlCenter
   Set pic = ActiveSheet.Pictures.Insert(sPath & sName)
   pic.ShapeRange.LockAspectRatio = False
   pic.Top = r.Top    ' Picture at the top
   pic.Left = r.Left
   ' column B, image needs to be reduced
   pic.Height = 80
   pic.Width = 109
   pic.OnAction = "PicAction2"
   Cells(rw, 2) = sName
'    sFirst = True
'    rw = rw + 1



sName = Dir()
Set r = Cells(rw, 3)
   r.Value = sName
   r.VerticalAlignment = xlBottom  ' text at the bottom
'    r.HorizontalAlignment = xlCenter
   Set pic = ActiveSheet.Pictures.Insert(sPath & sName)
   pic.ShapeRange.LockAspectRatio = False
   pic.Top = r.Top    ' Picture at the top
   pic.Left = r.Left
   ' column B, image needs to be reduced
   pic.Height = 80
   pic.Width = 109
   pic.OnAction = "PicAction3"
   Cells(rw, 3) = sName
'   sFirst = True
'   rw = rw + 1

sName = Dir()
Set r = Cells(rw, 4)
   r.Value = sName
   r.VerticalAlignment = xlBottom  ' text at the bottom
'    r.HorizontalAlignment = xlCenter
   Set pic = ActiveSheet.Pictures.Insert(sPath & sName)
   pic.ShapeRange.LockAspectRatio = False
   pic.Top = r.Top    ' Picture at the top
   pic.Left = r.Left
   ' column B, image needs to be reduced
   pic.Height = 80
   pic.Width = 109
   pic.OnAction = "PicAction4"
   Cells(rw, 4) = sName
   sFirst = True
   rw = rw + 1



End If
sName = Dir()
Loop
End Sub

This places four images in a row - 1 a,b,c,d. Clicking on the desired images enlarges it in 1 a. Then one can insert the LP number in 1 e. Re-clicking on the desired image reduces it to its original size and place the cursor in 2 e. In this manner you can go through all of the LPs, enlrge them if necessary to read the number and enter it 2,3, etc e.

Most of the LPs have four images but some have only three as
2013-09-03-09-09-09_13.jpg below.

2013-09-03-09-04-28_1.jpg
2013-09-03-09-04-28_2.jpg
2013-09-03-09-04-28_3.jpg
2013-09-03-09-04-28_4.jpg
2013-09-03-09-05-38_5.jpg
2013-09-03-09-05-38_6.jpg
2013-09-03-09-05-38_7.jpg
2013-09-03-09-05-38_8.jpg
2013-09-03-09-05-47_9.jpg
2013-09-03-09-05-47_10.jpg
2013-09-03-09-05-47_11.jpg
2013-09-03-09-05-47_12.jpg
2013-09-03-09-09-09_13.jpg
2013-09-03-09-09-09_14.jpg
2013-09-03-09-09-09_15.jpg
2013-09-03-09-13-23_20.jpg
2013-09-03-09-13-23_21.jpg
2013-09-03-09-13-23_22.jpg
2013-09-03-09-13-23_23.jpg

I would like to be able to change the script so that the images would be placed in a row related to their times. Those with four images with the same time would be place on a row, ie 1-a,b,c,d. Those with only three images with the same time would be placed on the same row, ie 2-a,b,c (there would be know 2-d).

In the file name 2013-09-03-09-04-28_1.jpg the second set of three numbers is the time (09-04-28).

Is this possible? I can email you the file with the images if you need them.

Thanks!

Ben

ANSWER: Ben,

Hopefully this will work for you:

Sub checkfiles()
Dim sPath As String, sName As String
Dim sFirst As Boolean, rw As Long
Dim pic As Picture
Dim r As Range
Dim sNameBase As String
sFirst = True
rw = 1
sPath = "C:\1. LP software\0. lpfinder\"
'sPath = "D:\C_Drive\Data\"
sName = Dir(sPath & "*.jpg")
Do While sName <> ""
If sFirst Then
   Set r = Cells(rw, 1)
   r.Value = sName
   sname1 = Left(sName, 19)
   r.VerticalAlignment = xlBottom  ' text at the bottom
'    r.HorizontalAlignment = xlCenter
   Set pic = ActiveSheet.Pictures.Insert(sPath & sName)
   pic.ShapeRange.LockAspectRatio = False
   pic.Top = r.Top   ' Picture at the top
   pic.Left = r.Left
   'Column A, image does not need to be reduced
   pic.Height = 80
   pic.Width = 109
   pic.OnAction = "PicAction1"
   sFirst = False
End If
   sName = Dir()
   Set r = Cells(rw, 2)
   r.Value = sName
   r.VerticalAlignment = xlBottom  ' text at the bottom
'    r.HorizontalAlignment = xlCenter
   Set pic = ActiveSheet.Pictures.Insert(sPath & sName)
   pic.ShapeRange.LockAspectRatio = False
   pic.Top = r.Top    ' Picture at the top
   pic.Left = r.Left
   ' column B, image needs to be reduced
   pic.Height = 80
   pic.Width = 109
   pic.OnAction = "PicAction2"
   Cells(rw, 2) = sName
'    sFirst = True
'    rw = rw + 1



sName = Dir()
Set r = Cells(rw, 3)
   r.Value = sName
   r.VerticalAlignment = xlBottom  ' text at the bottom
'    r.HorizontalAlignment = xlCenter
   Set pic = ActiveSheet.Pictures.Insert(sPath & sName)
   pic.ShapeRange.LockAspectRatio = False
   pic.Top = r.Top    ' Picture at the top
   pic.Left = r.Left
   ' column B, image needs to be reduced
   pic.Height = 80
   pic.Width = 109
   pic.OnAction = "PicAction3"
   Cells(rw, 3) = sName
'   sFirst = True
'   rw = rw + 1

sName = Dir()
' determine if this is the 4th of a set or 1st of the next set
If LCase(Left(sName, 19)) = LCase(sname1) Then
 Set r = Cells(rw, 4)
   r.Value = sName
   r.VerticalAlignment = xlBottom  ' text at the bottom
'    r.HorizontalAlignment = xlCenter
   Set pic = ActiveSheet.Pictures.Insert(sPath & sName)
   pic.ShapeRange.LockAspectRatio = False
   pic.Top = r.Top    ' Picture at the top
   pic.Left = r.Left
   ' column B, image needs to be reduced
   pic.Height = 80
   pic.Width = 109
   pic.OnAction = "PicAction4"
   Cells(rw, 4) = sName
   ' since processed the 4th, get a new 1st
   sName = Dir()
End If
' at this point, sName should be the first of a new set regardless
sFirst = True
rw = rw + 1

Loop
End Sub

--
Regards,
Tom Ogilvy


---------- FOLLOW-UP ----------

QUESTION: 1. That addition worked perfectly. I found that I had some sequences with 1 LP and 2 LPs also. I therefore entered:

' determine if this is the 3rd or 2nd of a set or 1st of the next set
If LCase(Left(sName, 19)) = LCase(sname1) Then

End if

above:

Set r = Cells(rw, 3) and Set r = Cells(rw, 2) and solved that problem.
2. I then wanted to place the sequences date\time stamp in (rw, 5) and added the following to the script below.

If sFirst Then
  Set r = Cells(rw, 1)
  r.Value = sName
  sName1 = Left(sName, 19)
  sName2 = Left(sName, 19) 'added
  r.VerticalAlignment = xlBottom  ' text at the bottom
'    r.HorizontalAlignment = xlCenter
  Set pic = ActiveSheet.Pictures.Insert(sPath & sName)
  pic.ShapeRange.LockAspectRatio = False
  pic.Top = r.Top   ' Picture at the top
  pic.Left = r.Left
  'Column A, image does not need to be reduced
  pic.Height = 120
  pic.Width = 165
  pic.OnAction = "PicAction1"
  sFirst = False
  
End If

Set r = Cells(rw, 5)  'added
  r.Value = sName2  'added   
  r.VerticalAlignment = xlBottom  ' text at the bottom  'added

This works fine. Is this the best place to insert it?

3. Lastly I have some sequences that overlap a second, such as:

2013-09-03-09-14-30
2013-09-03-09-14-30
2013-09-03-09-14-30
2013-09-03-09-14-31

Is ther any way to include these four in one sequence? I realize that by doing this, I may combine two sequences but I think I will more than likely unite a sequence!

Thanks again!

Ben

ANSWER: Ben,

for items 1 and 2, that is a little too abstract for me to comment on.  If it works/does what you want, then it must be right.

for example:  "some sequences with 1 LP and 2 LP" I would have to say "Huh??"  If you mean you had groups that instead of just being 3 or 4 members, they could be 1, 2, 3 or 4, then yes, you can put in a check for group membership where you process the 2nd, 3rd, and 4th members.  
Rather than have it straight linear, you might want to indent IF statements so it doesn't try to do 3 unless the 2nd one was processed as a group member , then it doesn't try to do 4 unless three was processed as a group member.


as for item 3,  there is nothing magic about using 19 as the length of the string to check.  So if you reduce it to look at the length that should match to form a group, then the would be my approach.  So in your example, I would change 19 to 16 and not look at the 30/31 in determining whether that is a group or not.   Make sure you make the change throughout if appropriate.

--
Regards,
Tom Ogilvy


---------- FOLLOW-UP ----------

QUESTION: I have one last problem. I have 431 images that I am using. There are a large number which are not being inserted into any of the 4 columns (A,B,C,D). Out of the first 102 images, there are 17 which are not inserted at all. I have tried this on two different computers. I do not see any obvious differences in the names of these images. I can not see any other reason that they are not being inserted.

Do you have and ideas? I can send you some of the the images and the exact script that I am using if that would be any help.

Thanks again!

Ben

Answer
Ben,

When you first asked your question way back when, as I recall, I was amazed it worked for you because it was totally dependent on what order the Dir command returned the filenames.  But you said it was working, so who was I to argue.  

So if you are getting some files that are not written, then I would suspect that the files are not being returned by DIR in an order that is consistent with the logic of your routine.  

I think you need to read all the filenames into an array (list), then sort the array to get the filenames in the right order and then process the array.   This assumes that the file names are part of the problem.  If the above is the problem, then sending me files to test with won't necessarily demonstrate the problem.  If you want to explore restructuring your code, then you can post the code and I will take a look.  

--
Regards,
Tom Ogilvy

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.