File folder to single spreadsheet

[shayne_bates]

I could really use some help with a macro. The goal is to get an entire folder with a couple thousand word documents to export to a single excel spreadsheet. Ideally I would like every document to occupy its own cell in a single row. Ive tried a few different things but cannot seem to get the script to run without errors. Does anyone have a solution to this?

[mdmackillop]

See this re cell limits (https://excel.tips.net/T003163_Character_Limits_for_Cells.html). Will this be an issue?

[shayne_bates]

No, I dont need to be able to read whats in the cells at all actually. The purpose is to be able to seach a single file for multiple instances amd create metrics based off that information. The documents themselves are not to large so they dont max the cells out.

[mdmackillop]

Can you post your code?

[shayne_bates]

Not currently. I am not at work and do not have a local copy. So ive given it a path to the folder and told it to look for .doc files and open in a new workbook but when i run it tells me there are no files in filder that match and gives me (myfolder) = emtpy.

[mdmackillop]

I've only tested on 2 word docs so can't tell if it will handle thousands

Sub GetWordDocs()
Application.ScreenUpdating = False
fld = "C:\VBAX\"
Set wordapp = CreateObject("word.Application")
f = Dir(fld & "*.do*")

i = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Do
i = i + 1
Set doc = wordapp.documents.Open(fld & f)
ActiveSheet.Cells(i, 1) = doc.Content
doc.Close False
f = Dir
Loop Until f = ""
wordapp.Quit
Application.ScreenUpdating = True
End Sub

[shayne_bates]

If this works you are my hero! Will post tomorrow when I give it a go.

[mdmackillop]

I suggest you split up your folder and run the code several times. Code above edited to allow for this.

[shayne_bates]

I keep getting a runtime error on i = activesheet.cells row. It gives me a rows.count but nothing else happens. If I remove this line I get the same error on the ActiveSheet.Cells row. Any solutions?

[mdmackillop]

Can you post your workbook?

[mdmackillop]

Have you changed this line to point to your files?

fld = "C:\VBAX\"

[shayne_bates]

Its an empty workbook... and yes, it doesn't have any problems locating where im pointing it to. it just gives a runtime error and shows that it counted rows. im really at a loss here.

[mdmackillop]

Here's my test workbook showing result. I put the path on the sheet for convenience.

[shayne_bates]

still throwing the same error. "application defined or object defined error" highlighting I = activesheet.cells line. I added the word directory to my references so its not that...

[mdmackillop]

Can't think what would cause this. Here's a "fully qualified" version with a little reordering. If this fails, please post your workbook.

Option Explicit
Sub GetWordDocs()
Dim xlapp As Object
Dim wordapp As Object
Dim doc As Object
Dim i%
Dim Fld$, f$

Set xlapp = Excel.Application
xlapp.ScreenUpdating = False
i = xlapp.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Fld = xlapp.Sheets(1).[B1]
Set wordapp = CreateObject("word.Application")
f = Dir(Fld & "*.do*")
Do
i = i + 1
Set doc = wordapp.documents.Open(Fld & f)
xlapp.Sheets(1).Cells(i, 1) = doc.Content
doc.Close False
f = Dir
Loop Until f = ""
wordapp.Quit
Application.ScreenUpdating = True
End Sub

[shayne_bates]

It works! However, it really doesn't like pulling more than about 7 files before getting an error. It also really doesn't like folders with subfolders. It won't even look into the subfolders for docs. Also there is this really weird thing that happens when you try and run the same folder, an error message from word comes up that says ***x.doc is locked for editing by "user_name". It's say it's at about a 90% solution at this point.

[mdmackillop]

to get an entire folder
No mention of subfolders!
I've tested it with 290 simple files of about 13kb each with no issues (which I know doesn't assist you). Can you post a couple of typical files which I can copy and test.

[shayne_bates]

I cannot. Trust me, I understand how much easier this would be if I could but these documents cannot be shared. The word docs are not anything complex. No graphs or charts or anything crazy, just text.

[mdmackillop]

OK
This will deal with subfolders. Don't know about other issues. Tested with 311 files

Sub GetWordDocs()
Application.ScreenUpdating = False

fld = Chr(34) & "C:\www\" & Chr(34) 'Change to suit

flist = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir " & fld & " /b /a-d /s").stdout.readall, vbCrLf), ".")
Set wordapp = CreateObject("word.Application")
For Each fd In flist
i = i + 1
Set doc = wordapp.documents.Open(fd)
ActiveSheet.Cells(i, 1) = doc.Content
'ActiveSheet.Cells(i, 2) = fd
doc.Close False
Set doc = Nothing
Next fd

wordapp.Quit
Application.ScreenUpdating = True
End Sub

[shayne_bates]

Alright so its running. But I get about 12 documents max before I get run-time error '1004'. Any suggestions? also, average file size is about 60kb if that helps.....

[mdmackillop]

A slight variation to try. This should skip temporary files and uses a temp variable which seems to help.

Sub GetWordDocs()
Application.ScreenUpdating = False


fld = Chr(34) & "C:\www\" & Chr(34) 'Change to suit


flist = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir " & fld & " /b /a-d /s").stdout.readall, vbCrLf), ".")
Set wordapp = CreateObject("word.Application")
For Each fd In flist
If Left(fd, 1) = "~" Then
'skip file
Else
i = i + 1
Set doc = wordapp.documents.Open(fd)
x = doc.Content
ActiveSheet.Cells(i, 1) = x
'ActiveSheet.Cells(i, 2) = fd
doc.Close False
Set doc = Nothing
End If
Next fd
wordapp.Quit
Application.ScreenUpdating = True
End Sub