jinx2013
New Member
- Joined
- Jun 5, 2013
- Messages
- 1
How can i modify the code below so it does the following:
- Extract data from all the documents within a folder- Not a single file at the time. I have to process 6000 word documents.
- Copies only the data within the cell that starts with "External References"- instead of every table within a document.
- Paste the name of the document in an adjacent cell to what is being imported.
- Each cell being copied needs to be pasted one after another in rows.
Im just a secretary and im not skilled in <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help;">VBA</acronym>, Can you please help me??
Sub ImportWordTable3()'Import all tables to a single sheetDim wdDoc As ObjectDim wdFileName As VariantDim TableNo As Integer 'table number in WordDim iRow As Long 'row index in WordDim jRow As Long 'row index in ExcelDim iCol As Integer 'column index in ExcelwdFileName = 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 fileWith wdDoc If wdDoc.tables.Count = 0 Then MsgBox "This document contains no tables", _ vbExclamation, "Import Word Table" Else jRow = 0 Sheets.Add after:=Sheets(Worksheets.Count) For TableNo = 1 To wdDoc.tables.Count With .tables(TableNo)'copy cell contents from Word table cells to Excel cells For iRow = 1 To .Rows.Count jRow = jRow + 1 For iCol = 1 To .Columns.Count On Error Resume Next ActiveSheet.Cells(jRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text) On Error GoTo 0 Next iCol Next iRow End With jRow = jRow + 1 Next TableNo End IfEnd WithSet wdDoc = NothingEnd Sub</pre>
- Extract data from all the documents within a folder- Not a single file at the time. I have to process 6000 word documents.
- Copies only the data within the cell that starts with "External References"- instead of every table within a document.
- Paste the name of the document in an adjacent cell to what is being imported.
- Each cell being copied needs to be pasted one after another in rows.
Im just a secretary and im not skilled in <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help;">VBA</acronym>, Can you please help me??
Sub ImportWordTable3()'Import all tables to a single sheetDim wdDoc As ObjectDim wdFileName As VariantDim TableNo As Integer 'table number in WordDim iRow As Long 'row index in WordDim jRow As Long 'row index in ExcelDim iCol As Integer 'column index in ExcelwdFileName = 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 fileWith wdDoc If wdDoc.tables.Count = 0 Then MsgBox "This document contains no tables", _ vbExclamation, "Import Word Table" Else jRow = 0 Sheets.Add after:=Sheets(Worksheets.Count) For TableNo = 1 To wdDoc.tables.Count With .tables(TableNo)'copy cell contents from Word table cells to Excel cells For iRow = 1 To .Rows.Count jRow = jRow + 1 For iCol = 1 To .Columns.Count On Error Resume Next ActiveSheet.Cells(jRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text) On Error GoTo 0 Next iCol Next iRow End With jRow = jRow + 1 Next TableNo End IfEnd WithSet wdDoc = NothingEnd Sub</pre>
