Hi,

I am trying to create a macro that will import data from every file in
a folder (all .DOC) into Excel in a structured format (one row per
document). Initially I thought that Copying and Pasting the tables
from each document would work but the formatting is very
inconsistant.

My preference would be to cycle through the field codes (table cells I
guess) and then place the contents in a cell on the spreadsheet. Since
code is not my strong point and controlling Word through Excel really,
really isn't a strong point any help would be greatly appreciated!

This is how far I have got just now for copying tables, ideally
copying the field codes would be betteralthough I am open for other
ideas if someone can help?

Sub PopulateExcel()

'Build the file list
Dim strFile As String, strFileList() As String, intFile As Integer,
myFilename As String
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document

'Folder location
path1 = "C:\123456\"
strFile = Dir(path1 & "*.doc")

While strFile < ""
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()

Wend

For intFile = 1 To UBound(strFileList)
myFilename = path1 & strFileList(intFile)
'Next intFile

Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Open(myFilename)

'For r = 1 To wrdDoc.Tables.Count

With wrdDoc
.unprotect “12345”
.ActiveWindow.Selection.Tables(1).Select
.Content.Copy
'.Tables(r).Range.Copy
End With

'Specify Excel File
Windows("Test.xls").Activate

'This new sheet was just for ease just now to let me see what was
actualyl working!
Sheets.Add

ActiveCell.PasteSpecial xlPasteValues
'Next r
Next intFile

'Close off files

wrdDoc.Close
wrdApp.Quit
Set wrdDoc = Nothing
Set wrdApp = Nothing


MsgBox "All Done"
End Sub

Best Regards,

CalumMurdo

I think the way you are going is the best method. I think you need to change
the formating after the data is entered into excel. first check to make usre
there aren't extra spaces at the beginning of end of the data then try this

Put code after this line
ActiveCell.PasteSpecial xlPasteValues


With ActiveSheet.Cells

.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False

With .Font
.Bold = False
.Italic = False
.Underline = xlUnderlineStyleNone
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.ColorIndex = xlAutomatic
End With
End With


" wrote:

Hi,

I am trying to create a macro that will import data from every file in
a folder (all .DOC) into Excel in a structured format (one row per
document). Initially I thought that Copying and Pasting the tables
from each document would work but the formatting is very
inconsistant.

My preference would be to cycle through the field codes (table cells I
guess) and then place the contents in a cell on the spreadsheet. Since
code is not my strong point and controlling Word through Excel really,
really isn't a strong point any help would be greatly appreciated!

This is how far I have got just now for copying tables, ideally
copying the field codes would be betteralthough I am open for other
ideas if someone can help?

Sub PopulateExcel()

'Build the file list
Dim strFile As String, strFileList() As String, intFile As Integer,
myFilename As String
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document

'Folder location
path1 = "C:\123456\"
strFile = Dir(path1 & "*.doc")

While strFile < ""
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()

Wend

For intFile = 1 To UBound(strFileList)
myFilename = path1 & strFileList(intFile)
'Next intFile

Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Open(myFilename)

'For r = 1 To wrdDoc.Tables.Count

With wrdDoc
.unprotect €œ12345€�
.ActiveWindow.Selection.Tables(1).Select
.Content.Copy
'.Tables(r).Range.Copy
End With

'Specify Excel File
Windows("Test.xls").Activate

'This new sheet was just for ease just now to let me see what was
actualyl working!
Sheets.Add

ActiveCell.PasteSpecial xlPasteValues
'Next r
Next intFile

'Close off files

wrdDoc.Close
wrdApp.Quit
Set wrdDoc = Nothing
Set wrdApp = Nothing


MsgBox "All Done"
End Sub

Best Regards,

CalumMurdo