Embedding Word Document within Excel

[Sam]

I would like to write a VBA procedure within Excel that
will allow me to embed/insert (not link) a Word document
(i.e. C:\My Documents\Test.doc) into the Excel worksheet.
The Excel worksheet would then allow me to click on the
embeded/inserted object for my perusal of the Test.doc
document. Any ideas?

If that's possible, is there a way for me to specify
several Word documents to embed/insert (i.e. wild
character searches, etc) into an Excel file and have all
of them embedded/inserted?

Any help in this matter would be greatly appreciated.

Sam

 

[Dave Peterson]

This might get you started:

Option Explicit
Sub testme03()

Application.ScreenUpdating = False

Dim myFiles() As String
Dim fCtr As Long
Dim iCtr As Long
Dim myFile As String
Dim myPath As String
Dim OLEObj As OLEObject

myPath = "c:\my documents\Word"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.doc")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
If LCase(myFile) Like "*asdf*.doc" Then
fCtr = fCtr + 1
ReDim Preserve myFiles(1 To fCtr)
myFiles(fCtr) = myFile
End If
myFile = Dir()
Loop

If fCtr > 0 Then
For fCtr = LBound(myFiles) To UBound(myFiles)
Application.StatusBar _
= "Processing: " & myFiles(fCtr) & " at: " & Now
With Worksheets("sheet1")
Set OLEObj = .OLEObjects.Add(Filename:=myPath & myFiles(fCtr), _
Link:=False, DisplayAsIcon:=False)
OLEObj.Top = .Cells(fCtr, "A").Top
OLEObj.Height = .Cells(fCtr, "A").Height
OLEObj.Left = .Cells(fCtr, "A").Left
OLEObj.Width = .Cells(fCtr, "a").Width
End With
Next fCtr
End If

With Application
.ScreenUpdating = True
.StatusBar = False
End With

End Sub

 

[Sam]

Thanks Dave . . . . I'll try it out and let you know if it
worked.

Sam

-----Original Message-----
This might get you started:

Option Explicit
Sub testme03()

Application.ScreenUpdating = False

Dim myFiles() As String
Dim fCtr As Long
Dim iCtr As Long
Dim myFile As String
Dim myPath As String
Dim OLEObj As OLEObject

myPath = "c:\my documents\Word"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.doc")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
If LCase(myFile) Like "*asdf*.doc" Then
fCtr = fCtr + 1
ReDim Preserve myFiles(1 To fCtr)
myFiles(fCtr) = myFile
End If
myFile = Dir()
Loop

If fCtr > 0 Then
For fCtr = LBound(myFiles) To UBound(myFiles)
Application.StatusBar _
= "Processing: " & myFiles(fCtr) & " at: " & Now
With Worksheets("sheet1")
Set OLEObj = .OLEObjects.Add

(Filename:=myPath & myFiles(fCtr), _