Macro, Perhaps?

J

JLilly

I guess I'll start off by saying that I'm still using Excel 97, which
I've been using for a while, but I'm not familiar with all of this
advanced stuff. Your help is appreciated!

Here is what I am trying to do:

I have a large list of item numbers - over 1,000. I would like to
either a) insert photos on another (hidden) page and link from my list
to the corresponding photo, or b) insert a hyperlink to my local photo
server. Option A is preferred as we will be able to use the photo
function off-line.

I know how to insert objects and hyperlinks on an individual basis, but
with 1,000+ item numbers this will take quite a bit of time. Is there a
way for me to write a macro which will do it for me?

Our photo server uses the following link,

http://photoserver/xy/xyzabc.jpg,

where xy are the first two #'s of the item number, and xyzabc is the
whole item number. Is it possible to create a macro of some sort which
will recognize these item numbers, and create a hyperlink or insert an
object on another page automatically, without me having to point Excel
to each of these photos individually?

Thanks in advance for your insight!
 
B

Bob Phillips

Copying all of the files into an Excel workbook is very simple, code below
shows how, but I wouldn't recommend as it is very slow and will make the
workbook huge.

How are you inserting the hyperlinks, is it pointing to a web site page or
what, I am confused by the second part.

Sub GetMyData()

Dim objFSO As Object
Dim objFolder As Object
Dim objSubfolder As Object
Dim objFile As Object
Dim iRow As Long
Dim oPicture As Object

iRow = 0
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("G:\DCIM\100_FUJI\")
For Each objFile In objFolder.Files
If objFile.Type = "JPEG Image" Then
Set oPicture =
Worksheets("Sheet2").Pictures.Insert(objFolder.Path & "\" & objFile.Name)
With oPicture
With .ShapeRange
.ScaleWidth 0.1, msoFalse, msoScaleFromTopLeft
.ScaleHeight 0.1, msoFalse, msoScaleFromTopLeft
.Left = iRow * 10
.Top = iRow * 100
End With
.Name = Left(objFile.Name, Len(objFile.Name) - 4)
End With
iRow = iRow + 1
End If
Next
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top