Open a Word doc and copy all to new Excel workbook

[rocknrisk]

Hi all,

I'm stepping out of the norm into API stuff that I know very little about. I need a macro to show me the Open Document Dialog box, select a Word file, copy all the data in the Word file, and paste the data into an Excel workbook. Please. I also need it to not paste the data all into one cell.

Can anyone help, please, please.

Thank you in advance.

"The important thing is not to stop questioning." - Albert Einstein

 

[MakeItSo]

Here's a way to use the Open dialog:

Dim dlg As Object, Direct$, xl as Excel.Workbook

Set dlg = WordBasic.DialogRecord.FileOpen(False)
WordBasic.CurValues.FileOpen dlg
dlg.Name = "*.*"
WordBasic.Dialog.FileOpen dlg
Direct$ = WordBasic.[Files$](".&quot

...
AppActivate Shell("Excel.exe",vbmaximizedfocus),1
Set xl=Excel.Workbooks.Add
...

Concerning the copy/paste issue: depends on what the contents of the doc are like - table? comma delimited? neither?

Cheers,
MakeItSo

Andreas Galambos
EDP / Technical Support Specialist
(andreas.galambos@bowneglobal.de)
HP:

http://www.andygalambos.de

 

[rocknrisk]

Hi Andreas,

Thank you. I will try that.

The Word doc has no formatting really. It is a report from another application.

Nice site by the way... I may read that "A Theory of Marble" sometime if I ever get some free time.

"The important thing is not to stop questioning." - Albert Einstein

 

[MakeItSo]

Hope I will have the entire theory in a publishable form until then-it's dynamite...

 

[rocknrisk]

Hi Andreas,

I cannot make your code work. It crashes my PC, unfortunately. So, I've tried to investigate a bit and have com up with this for now but it too does not work.

Sub test()
Dim wd As Object, wdData As Object
'Create a Microsoft Word session
Set wd = CreateObject("word.application&quot
'Open Word Doc
Set wdData = wd.Open("R:\doc1.doc&quot For Output As #1
'Copy all data from Word doc
With wdData.Selection
.WholeStory
.Copy
End With
...
' continue work in Excel
...
'Remove object from memory
Set wdData = Nothing
Set wd = Nothing
End Sub

Hi Everyone and Anyone,

To be honest, I've tried about 50 examples from the XL and Word help files and from the Internet. I even have a mate looking for me who does a similar job for another company. This has to be possible. All I want to do is Open a Word doc (Word itself may be closed prior so the app will need to be started), SelectAll (or WholeStory) and copy. I can do the rest once the data is pasted back in Excel. HELP, PLEASE, PLEASE!!!

Any help will be greatly appreciated.

Clinton

"The important thing is not to stop questioning." - Albert Einstein

 

[MakeItSo]

Hi Clinton.
This:
Set wdData = wd.Open("R:\doc1.doc&quot For Output As #1
won't work. The Open...for Output/Input/Append is for text files, not for (binary encoded) DOCs.
Here's some code of mine which I use to export text from an Excel sheet to a Worddoc. Feel free to use it and adapt it to your needs.
The "ExtractXLS.cfg" and BrowseForFolder part is to keep it useable on other machines. Path to Winword.exe will be stored in this little config. If you don't need that - leave it away..
I have only left away / commented out the most obviously useless part for your side and already tried to adapt the code slightly

[blue]
Sub ExportText()
Dim sh As Worksheet
Dim i As Integer, j As Integer, a As Integer
Dim msg, wort As String
Dim doc As Word.Document, wrd As Word.Application
Dim WordPath As String, buffer As String, Tagg As String

a = FreeFile
Open "C:\ExtractXLS.cfg" For Random As a
Get a, 2, buffer
If buffer <> &quot;&quot; Then
WordPath = buffer
Else
MsgBox &quot;Word 2000 - directory not determined.&quot;, vbInformation + vbOKOnly, &quot;Word 2000&quot;
WordPath = BrowseForFolder(&quot;Please specify MS Office folder&quot
buffer = WordPath & &quot;\Winword.exe&quot;
WordPath = buffer
Put #a, 1, &quot;&quot;
Put #a, 2, buffer
End If
Close a

AppActivate Shell(WordPath, 1), True
DoEvents
Set doc = Word.Documents.Open(&quot;R:\doc1.doc&quot
Set wrd = doc.Application
On Error Resume Next 'Just keep goin
wrd.Selection.TypeText &quot;$$$Workbook: &quot; & Excel.ActiveWorkbook.Name & vbCrLf
For Each sh In Me.Worksheets
msg = MsgBox( &quot;Export &quot; & sh.Name & &quot;?&quot;, vbQuestion + vbYesNoCancel)
If msg = vbCancel Then GoTo Schluss
If msg = vbNo Then GoTo skipme
wrd.Selection.TypeText &quot;$$$Sheet: &quot; & sh.Name
For j = 1 To sh.Columns.Count
For i = 1 To sh.Rows.Count
wort = Cells(i, j)
'Replace Line feed with <:sr>
wort = Replace(wort, Chr(10), &quot;<:sr>&quot
'Set Tags
'fon = Cells(i, j).Font.Name
Tagg = &quot;<Cells(&quot; & i & &quot;, &quot; & j & &quot &quot; & &quot;>&quot;
wrd.Selection.TypeText Tagg & wort & &quot;</Cells>&quot; & vbCrLf
Next
Next
skipme:
Next
Schluss:
End Sub

Public Function BrowseForFolder(sTitle As String)
Dim ctrShell As New Shell
Dim f As Folder
Dim fi As FolderItem
Set f = ctrShell.BrowseForFolder(0, sTitle, 1)
On Error GoTo Err_Canceled
Set fi = f.Items.Item
BrowseForFolder = fi.Path
Exit Function
Err_Canceled:
BrowseForFolder = &quot;&quot;
End Function

[/blue]

Hope this helps you,
Andy

Andreas Galambos
EDP / Technical Support Specialist
(andreas.galambos@bowneglobal.de)
HP:

http://www.andygalambos.de