macro to take info from Word to Excel

jlamusga

New Member
Joined
Sep 21, 2006
Messages
9
Help! I am fairly new to using macros (I did most of my programming in FORTRAN, yikes!) and I need to do a task. I have a form in Word that I go through and fill out different fields in the table with text. I need to be able to copy each specific field to an excel spreadsheet so we can have a database of the info. So far I am just recording a macro and trying to modify it. I can get excel to open, then i am stuck. This is what I have so far:
Sub Testing()
'
' Testing Macro
' Macro recorded 9/21/2006 by xzkryj
'
Selection.HomeKey Unit:=wdStory
Selection.MoveDown Unit:=wdLine, Count:=2
Selection.MoveRight Unit:=wdCell
Selection.Copy
Set appEX = CreateObject("Excel.Application")
appEX.Visible = True
appEX.Workbooks.Open FileName:="D:/AE Service Session/macro.xls"
End Sub

It needs to take the value that it copied and paste it into the first blank cell in column A. Any ideas?
-Joe
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
AppEX.ActiveSheet.Range("A" & appEx.Rows.Count).End(xlUp).offset(1,0).PasteSpecial xlPasteAll

This should do what you need.

HTH
Cal
 
Upvote 0
I am copying text (In this case a number, TVF233) out of the Word document, but it pasted it into the excel document as a picture on the worksheet. How do I change that?
-Joe
 
Upvote 0
Try this:

Code:
Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
"Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Set wdDoc = GetObject(wdFileName) 'open Word file
With wdDoc
TableNo = wdDoc.tables.Count
If TableNo = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
ElseIf TableNo > 1 Then
TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
"Enter table number of table to import", "Import Word Table", "1")
End If
With .tables(TableNo)
'copy cell contents from Word table cells to Excel cells
For iRow = 1 To .Rows.Count
For iCol = 1 To .Columns.Count
Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
Next iCol
Next iRow
End With
End With
Set wdDoc = Nothing
End Sub

I can't remenber who posted this :oops: but thanks anyway :biggrin:
 
Upvote 0
That didn't quite work. The first response worked except that it pasted the text info from the word doc into Excel as a picture rather than as text in a cell that I could do manipulations on.
-JL
 
Upvote 0
Did you try this?
AppEX.ActiveSheet.Range("A" & appEx.Rows.Count).End(xlUp).offset(1,0).PasteSpecial xlPastevalue
 
Upvote 0
I think the problem with my code is that your word code is selecting an object vs the text. I don't know the word object well enough to tell you how to fix that though. Can you select the data in some alternate way?
 
Upvote 0
here is a macro I use:
Code:
Sub OpenAndReadWordDoc()
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim tString As String, tRange As Word.Range
Dim p As Long, r As Long
'    Workbooks.Add ' create a new workbook
Worksheets("Input Data").Activate
    With Range("A1")
        .Formula = "Word Document Contents:"
        .Font.Bold = True
        .Font.Size = 14
        .Offset(1, 0).Select
    End With
    r = 3 ' startrow for the copied text from the Word document
    Set wrdApp = CreateObject("Word.Application")
    'wrdApp.Visible = True
    FilePath = Application.GetOpenFilename("Microsoft Word Document(*.doc), *.doc")
    Set wrdDoc = wrdApp.Documents.Open(FilePath)
    ' example word operations
    With wrdDoc
        For p = 1 To .Paragraphs.Count
            Set tRange = .Range(Start:=.Paragraphs(p).Range.Start, _
                End:=.Paragraphs(p).Range.End)
            tString = tRange.Text
            tString = Left(tString, Len(tString) - 1)
            ' check if the text has content
            If tString <> "" Then
                ' fill into active worksheet
                ActiveSheet.Range("A" & r).Formula = tString
                r = r + 1
            End If
        Next p
        .Close ' close the document
    End With
'    wrdApp.Quit ' close the Word application
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
    Call TrimChr
    Call cTransfer
    Call CSUpdates
    Worksheets("Input Data").Activate
    Range("A:A").Clear
    Worksheets("Start").Activate
    MsgBox "Done"
    ActiveWorkbook.Saved = True
End Sub

HTH
 
Upvote 0
The "picture" means that the "numbers" you are trying to get are actually being read/copied as text. Also, you can't manipulate text as numbers. You first need to convert text to numbers before you can perform calculations. Dave
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,114,002
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top