Importing Pictures

[jason52388]

This is what I have so far. Can't figure out what I'm doing wrong. I'm trying to import pictures from a folder based on the filenames listed in column C. I'm trying to import them to column A. Any ideas?

Sub Picture2()
Dim picname As String
Dim pasteAt As Integer
Dim lThisRow As Long

lThisRow = 2
Do While (Cells(lThisRow, 3) <> "")

pasteAt = lThisRow

'Dim picname As String
picname = Cells(lThisRow, 3) 'This is the picture name
On Error Resume Next


With Application.FileSearch
.LookIn = "J:\Int'l Growth Strategy\IGS Images\Shanghai Warehouse Catalog Images\"
.SearchSubFolders = True
.Filename = picname & ".jpg"

ActiveSheet.Pictures.Insert(.FoundFiles(i)).Select

'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection
'.Left = Range("A6").Left
'.Top = Range("A6").Top
.Left = Cells(pasteAt, 1).Left
.Top = Cells(pasteAt, 1).Top

.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 100#
.ShapeRange.Width = 80#
.ShapeRange.Rotation = 0#
End With
End With
lThisRow = lThisRow + 1

Loop

Range("A10").Select
Application.ScreenUpdating = True

End Sub

[GTO]

Greetings Jason,

Welcome to vbaexpress :-)

What year/version of Excel are you running?

Also - when posting code, use the vba tags like ' your code here..., or simply click the little green and white VBA button atop where you type the msg, and insert your code between the tags.

Mark

[jason52388]

2007

[Kenneth Hobs]

Then that would be the problem. FileSearch is not in 2007+. Use a Dir() or fso method to interate filenames in a folder. Do you need help with that?

[jason52388]

Ya I'm not sure how to do that. My main problem is that the pictures are in many different subfolders.

[Kenneth Hobs]

In this example, I used a Class to simulate FileSearch which uses the Microsoft Scripting Runtime. You will need to add the reference if you copy the classes to another file.

I also added a few other tweaks.

Sub Picture2()
Dim picname As String
Dim pasteAt As Integer
Dim lThisRow As Long

Dim i As Long, tf As Boolean
Dim fs As New cFileSearch
Dim fso As FileSystemObject

lThisRow = 2
Do While (Cells(lThisRow, 3) <> "")
pasteAt = lThisRow

'Dim picname As String
picname = Cells(lThisRow, 3) 'This is the picture name
'On Error Resume Next
With fs
.NewSearch
'.LookIn = "J:\Int'l Growth Strategy\IGS Images\Shanghai Warehouse Catalog Images"
.LookIn = "x:\pics"
.SearchSubFolders = True
.FileName = picname & ".jpg"
.Execute
tf = False
For i = 1 To .FoundFiles.Count
ActiveSheet.Pictures.Insert(.FoundFiles(i)).Select
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection
'.Left = Range("A6").Left
'.Top = Range("A6").Top
.Left = Cells(pasteAt, 1).Left
.Top = Cells(pasteAt, 1).Top
Rows(lThisRow & ":" & lThisRow).RowHeight = 100.5 'Width=14.57 set manually
Range("C" & lThisRow).HorizontalAlignment = xlCenter
Range("C" & lThisRow).VerticalAlignment = xlCenter
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 100#
.ShapeRange.Width = 80#
.ShapeRange.Rotation = 0#
End With
Exit For
Next i
End With
lThisRow = lThisRow + 1
Loop

Range("A10").Select
Columns("C:C").AutoFit

Application.ScreenUpdating = True
Set fs = Nothing
Set fso = Nothing
End Sub

[jason52388]

I appreciate the code. I do not follow what you mean about adding a reference tho. Sorry if this is basic stuff but how would I got about doing that?

[jason52388]

I tested the code and it works great. I appreciate the help.

[Kenneth Hobs]

For Intellisense to work, it must know the object and its methods and properties. If you early bind an object, it will know it. To set the reference, in the VBE, click the menus Tools > References... and pick the one detailed. You can do it in the file posted to see what I picked.

You will know that an object is late bound if CreateObject() or GetObject() is used. One can mix the two binding methods as well if needed.

[jason52388]

Thanks

[KevinT]

thanks