Script to import thumbnails-

mulletizer

New Member
Joined
Aug 17, 2011
Messages
3
Hey Forum, I could use some help automating the process of importing jpg thumbnails if anyone has the time. I saw some similar posts I am inspecting, but I thought I would post here as well just in case. We basically have many thumbnails that need to be imported corresponding to data in another column and it gets tedious importing the clip art.
Thank you.

Our setup is as follows.

Column A is empty, but needs to contain a thumbnail.
Column B contains the first part of the name of the thumbnail. Ex: "V01_01"

The thumbnails are contained in a constant path.

Z:\Folder1\Folder2\Thumbnails\V01_01.002459562.jpg

The last digits after the image name change based on the sequence it was created from. Ex:"Z:\Folder1\Folder2\Thumbnails\V02_09.002965345.jpg

The script would read in the image name in column B, search for a thumbnail in the constant path and import it into column A. During the import the thumbnail would need to be resized to .51 X.32

We are currently using Excel 2004 in OSX, but will be upgrading.

Any help or simple clues appreciated. Thanks again.

Jim
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Hello,

Welcome to the message board!

Have you any progress on this?

I beleive I have all the peices of code that could help you.
Just need to stitch them togather...
I do not yet have a complete answer for your question yet. I will keep working on it.


Would you clarify if there could possible be more than one file that matches the first part of the thumbnail?
Also what is the data in column B:B like... continuious, scatterd, B5:B32 ...?


So far I have code to resize to your requested size.
Code:
With ActiveSheet.Shapes("Rectangle 3")
        .Height = 0.51 * 72
        .Width = 0.32 * 72
    End With
"Rectangle 3" in the above would need to be the variable thumbnail.

Also code to find the files based on a partial match of the filename in the path specified. However, this needs more work to determine the range of your column B:B and to insert the found file based on the partial match using wildcards.

If nothing else, this will bump your thread to the top. :)

-Jeff
 
Upvote 0
Hey repairman615, thanks for the welcome. I am going to look at this harder tonight as well.

The data in column B is not ordered in the column, but will always have a match in the thumbnails directory. The name in this case is always 6 characters long in the format" V##_##". This would make the wildcard search easier. Coding wise, I would think it would be, for all selected columns in B, search the thumbnails directory for a thumbnail with a name matching the first 6 characters in B and import that thumbnail in A.

Thanks again for your help!
 
Upvote 0
Hello,

Here is what I have. I beleive Richard Schollar had something to do with the FileList function...

Copy this code into a standard module:

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> ThumbPartialName()<br><br><SPAN style="color:#00007F">Dim</SPAN> c               <SPAN style="color:#00007F">As</SPAN> Range, _<br>    Listrng         <SPAN style="color:#00007F">As</SPAN> Range, _<br>    i               <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _<br>    myvar           <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>, _<br>    myJPGobj        <SPAN style="color:#00007F">As</SPAN> OLEObject, _<br>    fPath           <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, _<br>    Ws              <SPAN style="color:#00007F">As</SPAN> Worksheet, _<br>    strFirstCell    <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <br>strFirstCell = "B4" <SPAN style="color:#007F00">''' Change this to your first cell with data in column B:B</SPAN><br>    <br><SPAN style="color:#00007F">Set</SPAN> Ws = Sheets("Sheet1")<br><SPAN style="color:#00007F">Set</SPAN> Listrng = Ws.Range(strFirstCell & ":B" & Range("B" & Rows.Count).End(xlUp).Row)<br>fPath = "C:\Users\standard account\Documents\"<br>    <SPAN style="color:#00007F">If</SPAN> Right(fPath, 1) <> "\" <SPAN style="color:#00007F">Then</SPAN> fPath = fPath & "\"<br>    <br>    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> Listrng<br>        <SPAN style="color:#00007F">If</SPAN> c.Value <> "" <SPAN style="color:#00007F">Then</SPAN><br>            <SPAN style="color:#007F00">'c.Select</SPAN><br>            myvar = FileList(fPath, c.Value & "*.pdf")<br>            <SPAN style="color:#00007F">If</SPAN> TypeName(myvar) <> "Boolean" <SPAN style="color:#00007F">Then</SPAN><br>                <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">UBound</SPAN>(myvar) - <SPAN style="color:#00007F">LBound</SPAN>(myvar) > 0 <SPAN style="color:#00007F">Then</SPAN><br>                    MsgBox "Multiple files match the entry:   " & c.Value & _<br>                            vbNewLine & "Located at:   " & c.Address & _<br>                            vbNewLine & "Only the first match will appear.", vbOKOnly, "Multiply results"<br>                    <SPAN style="color:#00007F">For</SPAN> i = <SPAN style="color:#00007F">LBound</SPAN>(myvar) <SPAN style="color:#00007F">To</SPAN> <SPAN style="color:#00007F">LBound</SPAN>(myvar)<br>                        <br>                        <SPAN style="color:#00007F">Set</SPAN> myJPGobj = ActiveSheet.OLEObjects.Add(Filename:= _<br>                            myvar(1), Link:=True, _<br>                            DisplayAsIcon:=False)<br>                            <SPAN style="color:#00007F">With</SPAN> myJPGobj<br>                                .Top = c.Top<br>                                .Left = c.Offset(0, -1).Left<br>                                .Height = 0.51 * 72<br>                                .Width = 0.32 * 72<br>                            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>                    <SPAN style="color:#00007F">Next</SPAN> i<br>                <SPAN style="color:#00007F">Else</SPAN><br>                    <SPAN style="color:#007F00">'For i = LBound(myvar) To UBound(myvar)</SPAN><br>                        <br>                        <SPAN style="color:#00007F">Set</SPAN> myJPGobj = ActiveSheet.OLEObjects.Add(Filename:= _<br>                            myvar, Link:=True, _<br>                            DisplayAsIcon:=False)<br>                            <SPAN style="color:#00007F">With</SPAN> myJPGobj<br>                                .Top = c.Top<br>                                .Left = c.Offset(0, -1).Left<br>                                .Height = 0.51 * 72<br>                                .Width = 0.32 * 72<br>                            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>                    <SPAN style="color:#007F00">'Next i</SPAN><br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            <SPAN style="color:#00007F">Else</SPAN><br>                MsgBox "For " & c.Value & ", no file was found,", vbOKOnly, "Possible Error"<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> c<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><SPAN style="color:#00007F">Function</SPAN> FileList(fldr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, <SPAN style="color:#00007F">Optional</SPAN> fltr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> sTemp <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, sHldr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <SPAN style="color:#00007F">If</SPAN> Right$(fldr, 1) <> "\" <SPAN style="color:#00007F">Then</SPAN> fldr = fldr & "\"<br>    sTemp = Dir(fldr & fltr)<br>    <SPAN style="color:#00007F">If</SPAN> sTemp = "" <SPAN style="color:#00007F">Then</SPAN><br>        FileList = <SPAN style="color:#00007F">False</SPAN><br>        <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Function</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Do</SPAN><br>        sHldr = Dir<br>        <SPAN style="color:#00007F">If</SPAN> sHldr = "" <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Do</SPAN><br>        sTemp = sTemp & "|" & sHldr<br>    <SPAN style="color:#00007F">Loop</SPAN><br>    FileList = Split(sTemp, "|")<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN></FONT>



Be sure to change the strFirstCell to your first (top) cell with data.

You can press Alt + F8 and select ThumbPartialName to run or call by other means.

-Jeff
 
Upvote 0
The above would not work as it is looking in the file path that exists on my computer... and also for a PDF... :oops:

Here is an update using your filepath and looking for a .JPG



<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br><br><SPAN style="color:#00007F">Sub</SPAN> ThumbPartialName()<br><br><SPAN style="color:#00007F">Dim</SPAN> c               <SPAN style="color:#00007F">As</SPAN> Range, _<br>    Listrng         <SPAN style="color:#00007F">As</SPAN> Range, _<br>    i               <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _<br>    myvar           <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>, _<br>    myJPGobj        <SPAN style="color:#00007F">As</SPAN> OLEObject, _<br>    fPath           <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, _<br>    Ws              <SPAN style="color:#00007F">As</SPAN> Worksheet, _<br>    strFirstCell    <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br><br><SPAN style="color:#007F00">''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''</SPAN><br>strFirstCell = "B4"    <SPAN style="color:#007F00">''' Change this to your first cell with data in column B:B</SPAN><br><SPAN style="color:#007F00">''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''</SPAN><br>    <br><SPAN style="color:#00007F">Set</SPAN> Ws = Sheets("Sheet1")<br><SPAN style="color:#00007F">Set</SPAN> Listrng = Ws.Range(strFirstCell & ":B" & Range("B" & Rows.Count).End(xlUp).Row)<br>fPath = "Z:\Folder1\Folder2\Thumbnails\"<br>    <SPAN style="color:#00007F">If</SPAN> Right(fPath, 1) <> "\" <SPAN style="color:#00007F">Then</SPAN> fPath = fPath & "\"<br>    <br>    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> Listrng<br>        <SPAN style="color:#00007F">If</SPAN> c.Value <> "" <SPAN style="color:#00007F">Then</SPAN><br>            <SPAN style="color:#007F00">'c.Select</SPAN><br>            myvar = FileList(fPath, c.Value & "*.jpg")<br>            <SPAN style="color:#00007F">If</SPAN> TypeName(myvar) <> "Boolean" <SPAN style="color:#00007F">Then</SPAN><br>                <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">UBound</SPAN>(myvar) - <SPAN style="color:#00007F">LBound</SPAN>(myvar) > 0 <SPAN style="color:#00007F">Then</SPAN><br>                    MsgBox "Multiple files match the entry:   " & c.Value & _<br>                            vbNewLine & "Located at:   " & c.Address & _<br>                            vbNewLine & "Only the first match will appear.", vbOKOnly, "Multiply results"<br>                    <SPAN style="color:#00007F">For</SPAN> i = <SPAN style="color:#00007F">LBound</SPAN>(myvar) <SPAN style="color:#00007F">To</SPAN> <SPAN style="color:#00007F">LBound</SPAN>(myvar)<br>                        <br>                        <SPAN style="color:#00007F">Set</SPAN> myJPGobj = ActiveSheet.OLEObjects.Add(Filename:= _<br>                            myvar(1), Link:=True, _<br>                            DisplayAsIcon:=False)<br>                            <SPAN style="color:#00007F">With</SPAN> myJPGobj<br>                                .Top = c.Top<br>                                .Left = c.Offset(0, -1).Left<br>                                .Height = 0.51 * 72<br>                                .Width = 0.32 * 72<br>                            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>                    <SPAN style="color:#00007F">Next</SPAN> i<br>                <SPAN style="color:#00007F">Else</SPAN><br>                    <SPAN style="color:#007F00">'For i = LBound(myvar) To UBound(myvar)</SPAN><br>                        <br>                        <SPAN style="color:#00007F">Set</SPAN> myJPGobj = ActiveSheet.OLEObjects.Add(Filename:= _<br>                            myvar, Link:=True, _<br>                            DisplayAsIcon:=False)<br>                            <SPAN style="color:#00007F">With</SPAN> myJPGobj<br>                                .Top = c.Top<br>                                .Left = c.Offset(0, -1).Left<br>                                .Height = 0.51 * 72<br>                                .Width = 0.32 * 72<br>                            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>                    <SPAN style="color:#007F00">'Next i</SPAN><br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            <SPAN style="color:#00007F">Else</SPAN><br>                MsgBox "For " & c.Value & ", no file was found.", vbOKOnly, "Possible Error"<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> c<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br><SPAN style="color:#00007F">Function</SPAN> FileList(fldr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, <SPAN style="color:#00007F">Optional</SPAN> fltr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> sTemp <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, sHldr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <SPAN style="color:#00007F">If</SPAN> Right$(fldr, 1) <> "\" <SPAN style="color:#00007F">Then</SPAN> fldr = fldr & "\"<br>    sTemp = Dir(fldr & fltr)<br>    <SPAN style="color:#00007F">If</SPAN> sTemp = "" <SPAN style="color:#00007F">Then</SPAN><br>        FileList = <SPAN style="color:#00007F">False</SPAN><br>        <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Function</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Do</SPAN><br>        sHldr = Dir<br>        <SPAN style="color:#00007F">If</SPAN> sHldr = "" <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Do</SPAN><br>        sTemp = sTemp & "|" & sHldr<br>    <SPAN style="color:#00007F">Loop</SPAN><br>    FileList = Split(sTemp, "|")<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN><br></FONT>



Let me know if you need help inserting this.

-Jeff
 
Last edited:
Upvote 0
Hey Mullitizer,

Checking in to see what happened. Please let me know as I am curious about your results.

Thanks,

Jeff
 
Upvote 0
I apologize for not updating this. I got discouraged and gave up at the time, but I am back on it. I'll let you know when I have it working. Thanks again for your help.
 
Upvote 0

Forum statistics

Threads
1,224,557
Messages
6,179,507
Members
452,917
Latest member
MrsMSalt

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top