application.filesearch replacement for 2007

jkomorowski

New Member
Joined
Jun 26, 2008
Messages
12
Hi, I am fairly new to macro writing and am having trouble converting an old macro that I had working for 2003, but that wont work for 2007. I have searched the internet and found numerous other postings on replacing application.filesearch, but I can't seem to get any of them working for me.

I am trying to search a folder that is selected by the user for all .jpg files, and then place all those pictures onto a certain spreadsheet within the excel file. It also formats the pictures. Following is the code:

Code:
   Private Sub BatchProcessThumb2x3()
    Msg = "Select a file containing the photos you want to insert."
    Directory = GetDirectory(Msg)
    If Directory = "" Then Exit Sub
    If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
 
    On Error Resume Next
    With Application.FileSearch
        .NewSearch
        .LookIn = Directory
        .Filename = "*.jpg"
        .SearchSubFolders = False
        .Execute
 
'   Select begining range
    Worksheets("Thumbnail (2x3)").Select
    Range("B4").Select
'   Loop through all files and process them
 
        For i = 1 To .FoundFiles.Count
            Application.StatusBar = "Processing " & .FoundFiles(i)
'   Import and insert the photo
            ActiveSheet.Pictures.Insert(.FoundFiles(i)).Select
            Selection.ShapeRange.LockAspectRatio = msoTrue
            Selection.ShapeRange.Width = 225#
 
            If Int(i / 2) - (i / 2) <> 0 Then _
                ColOff = 3 Else ColOff = -3
            If Int(i / 2) - (i / 2) <> 0 Then _
                RowOff = 0 Else RowOff = 4
            ActiveCell.Offset(RowOff, ColOff).Select
        Next i
            Application.StatusBar = False
    End With
End Sub


Any and all help would be greatly appreciated.

Thanks, Jason
 

Some videos you may like

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
trt
Code:
   Private Sub BatchProcessThumb2x3()
    Msg = "Select a file containing the photos you want to insert."
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            Directory = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    fn = Dir(Directory & "\*.jpg")
    Worksheets("Thumbnail (2x3)").Select
    Range("B4").Select
    Do While fn <> ""
        i = i + 1
        Application.StatusBar = "Processing " & fn
        ActiveSheet.Pictures.Insert(Directory & "\" & fn)
        ActiveSheet.Pictures.Insert(.FoundFiles(i)).Select
        Selection.ShapeRange.LockAspectRatio = msoTrue
        Selection.ShapeRange.Width = 225#
            If Int(i / 2) - (i / 2) <> 0 Then _
                ColOff = 3 Else ColOff = -3
            If Int(i / 2) - (i / 2) <> 0 Then _
                RowOff = 0 Else RowOff = 4
            ActiveCell.Offset(RowOff, ColOff).Select
    Loop
            Application.StatusBar = False
End Sub
 

jkomorowski

New Member
Joined
Jun 26, 2008
Messages
12
Thanks for the quick help. I am now getting an error that state "Compile error: Invalid or unqualified reference." I get this error on the folowing line of code and it highlights ".FoundFiles".

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

Any ideas?

Thanks, Jason
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
Can you change
Rich (BB code):
        ActiveSheet.Pictures.Insert(Directory & "\" & fn)
        ActiveSheet.Pictures.Insert(.FoundFiles(i)).Select
to
Rich (BB code):
        ActiveSheet.Pictures.Insert(Directory & "\" & fn).Select
 

jkomorowski

New Member
Joined
Jun 26, 2008
Messages
12

ADVERTISEMENT

It compiles, but now gives the following error while running through the following line of code:

run-time error '9'
Subscript out of range


Code:
Worksheets("Thumbnail (2x3)").Select
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
That means either

1) Thumbnail (2x3) sheet is not exist
2) Thumbnail (2x3) is somehow miss-spelled
 

jkomorowski

New Member
Joined
Jun 26, 2008
Messages
12

ADVERTISEMENT

I removed that line of code and it almost works now. The following is what transpires:

It asks me to choose a folder, which I do.
It then places the first picture from that folder onto the appropriate spreadsheet and also formats it correctly.
Next it places the same picture where the second picture should have gone.
It continues to place just that one pictre where the next pictures should go.
It runs continuously, placing the same picture 1000's of times before I press esc to exit the code.

It does not seem to be stepping through the 8 .jpg files that are in the folder that I choose, and therefore never comes to an end.

Any ideas how that could be fixed?

Thanks,
Jason
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
OOOOps
Missed a line
Rich (BB code):
            ActiveCell.Offset(RowOff, ColOff).Select
            fn = Dir()
    Loop
 

jkomorowski

New Member
Joined
Jun 26, 2008
Messages
12
So close now. Thanks for all your help, you have been truely amazing. Now when I run it, it steps thgough the photos correctly, but for some reason places all photos in the same spot instead of where the active cell seems to be.

It places in the correct location in 2003, but not in 2007.

What do you think could be causing this?

Thanks again,
Jason
 

Watch MrExcel Video

Forum statistics

Threads
1,123,259
Messages
5,600,575
Members
414,390
Latest member
plimbu

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
Top