application.filesearch replacement for 2007

[jkomorowski]

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:

   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

 

[jindon]

trt

   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]

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".

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

Any ideas?

Thanks, Jason

 

[jindon]

Can you change

        ActiveSheet.Pictures.Insert(Directory & "\" & fn)
        ActiveSheet.Pictures.Insert(.FoundFiles(i)).Select

to

        ActiveSheet.Pictures.Insert(Directory & "\" & fn).Select

 

[jkomorowski]

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

run-time error '9'
Subscript out of range

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

 

[jindon]

That means either

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

 

[jkomorowski]

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]

OOOOps
Missed a line

            ActiveCell.Offset(RowOff, ColOff).Select
            fn = Dir()
    Loop

 

[jkomorowski]

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

 

[jindon]

Sorry, but I don't know about 2007...