inserting all graphics in folder into Word doc

[Dogwoodnc]

We have been using the macro below for years in the Word 2003 environment.
The macro lets you select a folder and then it inserts all jpg graphics in
that folder into a blank Word doc.

In preparing to migrate to Word 2007, I've found that the macro does not
work at all there, returning the Runtime error 5111, "This command is not
available on this platform", highlighting the With Application.FileSearch
line. Internet research says that the Application.FileSearch object is no
longer available, but is replaced by FileSystemObject in later versions. I'm
not a programmer, but have been trying to follow instructions to replace this
object -- with absolutely no success. Any advice about what specifically I
need to do in order to make this macro work (OR any other macro that would
perform the same function) would be greatly appreciated. Thank you!

dogwoodnc

Source of original macro:
http://www.tech-archive.net/Archive/Word/microsoft.public.word.vba.general/2006-08/msg00046.html

Other resources I've looked at today:
http://support.microsoft.com/kb/920229
http://support.microsoft.com/kb/185601/
http://www.tek-tips.com/faqs.cfm?fid=4116

BTW, I've made sure to checkmark the References to both the Shell Control &
Automation commands and the Microsoft Scripting Runtime commands (under
Tools).


Original macro (which worked on Word 2003):


Sub InsAllPics()

Dim strFldr As String
Dim strFName As String
Dim cntFiles As Long
Dim thisFile As Long
Dim cntShape As Long
Dim oIShape As InlineShape
Dim strLookIn As String
Dim strPName As String
Dim ChrPos As Integer

strLookIn = GetFolderName("Choose a folder")

cntShape = 0
thisFile = 1
With Application.FileSearch
..LookIn = strLookIn
..FileName = "*.jpg"
..Execute

cntFiles = .FoundFiles.Count

Do
strFName = .FoundFiles(thisFile)
Set oIShape = Selection.InlineShapes.AddPicture(strFName)

' The following bits were used to set the height and width
' of an inserted graphic or photo.
''' oIShape.LockAspectRatio = msoTrue
''' oIShape.Height = InchesToPoints(9)
''' oIShape.ScaleWidth = oIShape.ScaleHeight

''' If oIShape.Height > 360# Then
''' oIShape.Height = InchesToPoints(5)
''' oIShape.ScaleWidth = oIShape.ScaleHeight
''' End If

thisFile = thisFile + 1

Selection.Collapse Direction:=wdCollapseEnd
Selection.TypeParagraph

' This part is where the file name is inserted
' You can substitute another string
ChrPos = InStrRev(strFName, "\")
strPName = Right(strFName, Len(strFName) - ChrPos)
Selection.Text = strPName
Selection.Collapse wdCollapseEnd
''Selection.InsertBreak Type:=wdPageBreak
Selection.TypeParagraph
Selection.TypeParagraph

' This code has been through some adjustments, and I
' don't always remove the bits and pieces from before.
' As it is right now, it puts paragraphs after each inserted
' photo. As it was before, using the sizing options above,
' it inserted two photos next to each other and then inserted
' paragraphs using the bit below.
''' cntShape = cntShape + 1
''' If cntShape = 2 Then
''' Selection.TypeParagraph
''' cntShape = 0
''' End If

Loop Until thisFile > cntFiles

End With

End Sub

''' This function opens a folder list box to let you
''' select the folder containing your photos. Don't
''' forget to set the library reference.
Function GetFolderName(sCaption As String) As String
'Needs a reference to (Tools > Reference)
'Microsoft Shell Controls And Automation
Dim oShell As Shell32.Shell
Dim oFolder As Shell32.folder
Dim oItems As Shell32.FolderItems
Dim Item As Shell32.FolderItem

On Error GoTo CleanUp

Set oShell = New Shell
Set oFolder = oShell.BrowseForFolder(0, sCaption, 0)
Set oItems = oFolder.Items
Set Item = oItems.Item

GetFolderName = Item.path

CleanUp:
Set oShell = Nothing
Set oFolder = Nothing
Set oItems = Nothing
Set Item = Nothing

End Function

 

[Fumei2 via OfficeKB.com]

"Internet research says that the Application.FileSearch object is no
longer available, but is replaced by FileSystemObject in later versions. "

This is not fully correct. FileSystemObject has been around for a long time,
and does not "replace" FileSearch. I have no idea why Microsoft removed
FileSearch from the object model, but it is very annoying that they did.

There are some work around replacement DLL for FileSearch that functions
quite well actually.

However, from the looks at what you are doing, a simple use of Dir() may do
the trick.

Dim file ' to use for the graphic file

strLookIn = GetFolderName("Choose a folder")

file = Dir(strLookin & "\" & "*.jpg")

Do While file <> ""
strFName = strLookin & "\" & file
Set oIShape = Selection.InlineShapes.AddPicture(strFName)
' your other stuff
file = Dir()
Loop

Gerry

 

[Doug Robbins - Word MVP]

Here's part of a macro that allows the user to browse to and select a folder
and then inserts all of the .jpg files from that folder into the active
document:

Dim fd As FileDialog
Dim strFolder As String
Dim myFile As String
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Select the folder that contains the files."
If .Show = -1 Then
strFolder = .SelectedItems(1) & "\"
Else
MsgBox "No folder selected."
Exit Sub
End If
End With
myFile = Dir(strFolder & "*.jpg")
While myFile <> ""
With ActiveDocument
.Range.Collapse wdCollapseEnd
.InlineShapes.AddPicture strFolder & myFile
.Range.Collapse wdCollapseEnd
.Range.InsertAfter vbCr & myFile & vbCr
End With
myFile = Dir()
Wend


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

 

[Dogwoodnc]

Thank you to BOTH Doug and Gerry! It's working great now!

This newsgroup is wonderful!!