Solved: send words to excel

[peterwmartin]

Hi all
Can someone help me with this bit of code it seems to be all there however I am not seeing the logic. I am trying to take the individual words from a word doc and place each word into a new cell:banghead: .


Private Sub CommandButton1_Click()
Dim appExcel As Object
Dim objSheet As Object


If objSheet Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
Set objSheet = appExcel.workbooks.Open _
("C:\Documents and Settings\z81288\Desktop\My Targeted Performance\fromword.xls") _
.Sheets("Sheet1")
End If

For x = 1 To 100
Set myrange = ActiveDocument.Range(Start:=0, End:=Selection.End)
For Each aword In myrange.Words
objSheet.Range("a" & x).Value = aword
Next
Next
If Not objSheet Is Nothing Then
appExcel.workbooks(1).Close True
appExcel.Quit
Set objSheet = Nothing
Set appExcel = Nothing
End If
End Sub



Thanks, If this is totally wrong please offer some direction.

Edit: Line breaks added for folks with small monitors....Lucas

[XLGibbs]

Try this alteration.

You can do a couple fo things, but you have to open or add the workbook before referencing a sheet in it. In this below, I have just added the workbook.

You can also .Open the workbook with your path. Once the workbook is open, you can set the worksheet.


Private Sub CommandButton1_Click()
Dim appExcel As Object
Dim objWorkbook As Object
Dim objWorksheet As Object

On error goto EarlyOut:

'If objSheet Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
Set objWorkbook = appExcel.workbooks.Add
Set objWorksheet = objWorkbook.Sheets(1)
'End If

For x = 1 To 100
Set myrange = ActiveDocument.Range(Start:=0, End:=Selection.End)
For Each aword In myrange.Words
objWorksheet.Range("a" & x).Value = aword
Next
Next
'If Not objSheet Is Nothing Then

appExcel.Close True

EarlyOut:

appExcel.Quit

Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set appExcel = Nothing
'End If
End Sub


Edit: YOu should also have an error handler to kill the AppExcel from active memory if the procedure fails..so I added that.

I commented out the If..Then's for If is nothing

[peterwmartin]

Thanks XL
The error handling had been causing me alot of problems I had a lot of open documents. The code I have written however is still writing the first word 100 times.
thanks

[XLGibbs]

The problem is that you are saying

For x = 1 to 100
For each aword....
Next aword
Next x

While the logic for which cell, specifically, each row from 1 to 100 downward in column A is correct, but it is not properly adjusting x for each word.

You might try

Set myrange = ....
For x = to myrange.words.count
objWorksheet.Cells(x,1) = myrange.words(x)
Next x

I don't have much experience with Word ranges though, but my guess is you want the myrange array index (myrange.words(x)) to increment along with the row number.

So it would cycle through Cells(1,1) = myrange(1).....cells(100,1) = myrange(100)...

Not sure, but I am trying to improve my word skills as well, so I will play around with it.

[XLGibbs]

Dim myrange As Range
'For x = 1 To 100
Set myrange = ActiveDocument.Range(Start:=0, End:=Selection.End)
For x = 1 To myrange.Words.Count
objWorksheet.Range("a" & x).Value = myrange.Words(x)
Next


Hi, I just tested a loop using the above and it works fine. I did 20 words, and they went in column A in order. Replace your For x = and For each loop with that...should be fine.

[peterwmartin]

Thanks again XL
I wasn't too far off. However in vba it seems not too far may as well be playing on the xbox.
Thanks

[XLGibbs]

Not at all, you were really close, which made it much easier for me to figure out a way to help out.

[XLGibbs]

PS. I am pretty sure there is an easier way, although my lack of experience with word reveals itself in my not knowing the easier way.

Happy to help out nonetheless.