PDA

View Full Version : Import/Extract Information from Word to Excel using VBA



sanket84
11-25-2016, 04:30 AM
Hello All,

I have hundreds of word files. Each of these word files is in the format of a table. I need to extract certain information from each of these word files and paste it in excel in separate columns.

Example of word file:



heading1
sensor information need to be clarified




dateofgather
21-11-2016




group1
002
1.2
3.4


group2
101
4.2
5.1


comments
need to be re calibrated and redone






In this above example, all of this, is in the form a table in a single word document. All the words files have the same format but the values shown above (in bold) keep changing. I need to copy these values into a single excel spreadsheet (in separate columns) and do it for all the word files.

For this, I need to use a VBA script in Excel, thereby creating a macro, which would enable me to extract all the information I need from all these word files, placed inside a single folder, into a single excel spreadsheet.

Please let me know if this can be done because this is really urgent. Thanks to all of you for your suggestions and help.

p45cal
11-25-2016, 06:40 AM
Atach 2 sample Word files.

sanket84
11-25-2016, 06:58 AM
Please find the attached word files. The numbers that are changing in these documents are the ones that I need to extract into different columns in excel. I have 100s of such word documents in a folder and I need to do the same for all of them.

sanket84
11-25-2016, 07:00 AM
Please suggest. Your help in due regards is truly appreciated. Thanks a lot.

sanket84
11-25-2016, 07:30 AM
And apart from the above attached 2 documents, there are few documents which have "N/A" written instead of those numbers.

p45cal
11-25-2016, 08:56 AM
You'll have to be moreprecise about which values you want to extract since those files have no instances of group1/group2 anywhere.
17697

sanket84
11-25-2016, 09:15 AM
The values that I want to extract are:

1. ID
2. Easting
3. Northing
4. Cylinder: all three values into separate columns

I apologize for not being discrete but I hope this explains.

Thanks

p45cal
11-25-2016, 11:14 AM
Press button in attached.
Basic, hardcoded, no error checks, see how you get on.

sanket84
11-25-2016, 09:58 PM
The code that you sent is working absolutely fine. Thanks a ton for all your help and support.

However, I am facing one additional problem. There is a third kind of file, example attached. In this file, you will see the information that I am trying to extract is double. So, there are 2 easting northing values which I need (so it has to be 24,2,24,4,26,2 and 26,4) and then there are 2 separate rows that I need to extract as well (27,2,27,3,27,4 and 33,2,33,3,33,4).

If I incorporate this in the present macro, it hits an error wherever it goes from the first kind of word file (for which you have already given a solution) and the aforesaid kind of word file. This is because the corresponding row,column count does not match.

Is there a way that the macro first checks of the table in the word file has greater than certain number of rows: if Yes then it proceeds with a different row,column combination and if NO, then it proceeds with the other kind of row,column combination.

Is this possible. Please take a look into the example file and let me know your thoughts on the same.

Thank you very much again.

sanket84
11-25-2016, 10:18 PM
Hence, to add to my last post,

IF rowcount > 34 , Then We need a new solution wherein we need (16,3,24,2,24,4,26,2,26,4,29,2,29,3,29,4,33,2,33,3,33,4)
ELSE we need the solution that you have already provided (16,3,24,2,24,4,27,2,27,3,27,4)

Please let me know if its possible to do this.

Thanks

p45cal
11-26-2016, 07:19 AM
Sub blah()
Dim Results(), WdApp As Object
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select folder with Word docs in"
.Show
v = .SelectedItems(1)
End With
Set NewSht = Sheets.Add(After:=Sheets(Sheets.Count))
Set Destn = NewSht.Cells(2, 1)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set myFolder = FSO.GetFolder(v).Files
For Each myFile In myFolder
If LCase(myFile) Like "*.doc" Or LCase(myFile) Like "*.docx" Or LCase(myFile) Like "*.docm" Then
If WdApp Is Nothing Then
On Error Resume Next
Set WdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then 'Word not yet running
Set WdApp = CreateObject("Word.Application")
DeleteMeLater = True
End If
On Error GoTo 0
WdApp.Visible = True
End If
Set wdDoc = WdApp.Documents.Open(CStr(myFile), ReadOnly:=True)
Set theTable = wdDoc.Tables(1)
If theTable.Rows.Count < 35 Then
Coords = Array(16, 3, 24, 2, 24, 4, 27, 2, 27, 3, 27, 4)
ReDim Results(0 To 5)
Else
Coords = Array(16, 3, 24, 2, 24, 4, 29, 2, 29, 3, 29, 4, 26, 2, 26, 4, 33, 2, 33, 3, 33, 4)
' Coords = Array(16, 3, 24, 2, 24, 4, 26, 2, 26, 4, 29, 2, 29, 3, 29, 4, 33, 2, 33, 3, 33, 4)
ReDim Results(0 To 10)
End If
j = 0
For i = LBound(Coords) To UBound(Coords) Step 2
Set mycell = theTable.Cell(Coords(i), Coords(i + 1))
Results(j) = Application.WorksheetFunction.Clean(mycell.Range.Text)
If IsNumeric(Results(j)) Then Results(j) = Val(Results(j))
j = j + 1
Next i
Destn.Resize(, UBound(Results) + 1).Value = Results
Set Destn = Destn.Offset(1)
wdDoc.Close
End If 'LCase
Next myFile
If DeleteMeLater Then WdApp.Quit
MsgBox "Done"
End Sub

Naziya
11-28-2016, 02:28 AM
Hi, i have a similar type of scenario where table from excel needs to be pasted in specific paragraph.

Below is the code which will copy the selected area from excel and its not pasting in word, please help.

Sub Test()
Sheets("Sheet1").Select
With ActiveSheet
.AutoFilterMode = False
.Range("A1:I1").AutoFilter
.Range("A1:I1").AutoFilter Field:=1, Criteria1:=InputBox("Please provide Country name")
End With
With ActiveSheet.AutoFilter.Range
.Offset(1, 0).Resize(.Rows.Count - 1).Copy
End With


'Opening the word document
Set wordapp = CreateObject("word.Application")
wordapp.documents.Open
wordapp.Visible = True


End Sub

p45cal
12-15-2016, 01:48 PM
I wonder if my last offering was any good…