1000+ File data extract (97 sr2)

[jharrisiii]

<img src=/S/crybaby.gif border=0 alt=crybaby width=15 height=15> Impending inventory software implementation requires extracting 25-40 data fields from 1000+ legacy XLS files. <img src=/S/puke.gif border=0 alt=puke width=60 height=15>

<img src=/S/sad.gif border=0 alt=sad width=15 height=15> Unfortunately, Excel was used a "product" sheet generator with one sheet per file, laid out to print as 3-hole punch inventory sheet.

<img src=/S/smile.gif border=0 alt=smile width=15 height=15> Fortunately, each file/sheet has a consistent layout; i.e., the product 'style' number is always in B2.

<img src=/S/help.gif border=0 alt=help width=23 height=15> Looking for quick and dirty VBA module or code fragment that would cycle through all XLS files in a target directory and copy target cells into a new consolidated file/sheet.

This is a one-time event so it doesn't have to be pretty.
Didn't see anything close in the archives.
The sample file has been changed to protect the innocent.

Any and all comments or suggestions greatly appreciated.

TIA

[jscher2000]

I haven't done any automation of Excel to speak of, but I suspect that you would be better off using ADO or another smallish DLL than opening/closing each Workbook in Excel.

The Lounge probably has a half dozen theads on looping through a folder (e.g., using the FileSystemObject).

I'm not sure if there is as much on using, for example, ADO, to read a cell out of a worksheet. You could start with HOWTO: Use ADO with Excel Data from Visual Basic or VBA (Q257819)

[jharrisiii]

This provides a great start. Thanks.

I can also have some fun in the archives now that I know what to look for (FileSystemObject).

It looks like the hairiest part is going to be specifing the name of the file to open; there are ~1200. Maybe open a SourceDir*.xls, then FileSaveAs NewDir*.xls, then data copy, data write to master file, then close, then open next SourceDir*.xls.

Oh the fun...

Again thanks for the direction.

<img src=/S/salute.gif border=0 alt=salute width=15 height=20>

[ambrose]

Maybe you could use the old DOS BATCH function FOR %f IN (*.XLS) and call something to extract from each file? I haven't used this in ages but maybe someone here knows what I am talking about and can give you a better idea.

[Hans Pottel]

This post might help you starting as well.

[LegareColeman]

The code below will open all *.xls files in directory C:Work. You can supply the code to copy and paste what you need where indicated, or give us some more information about what cells on what worksheet need to be copied.

<pre>Public Sub OpenAllFiles()
Dim strFName As Variant
Dim oWB As Workbook
strFName = Dir("C:Work*.xls", vbNormal)
While strFName <> ""
Set oWB = Workbooks.Open("C:work" & strFName)
' Do your copy and paste here
oWB.Close
strFName = Dir()
Wend
End Sub
</pre>

[jscher2000]

That long MS article says I can retrieve the sheet names without ADOX, and that's got to be faster. Here's a revised version that does just that.

[jharrisiii]

From all of the posts, pointers, and code, it looks like cycling through the files is going to be a lot easier than I could have imagined.

My procedure outline is shaping up like this:
Open each worksheet in turn.
Create new summary data row with data copied from target cells.
Copy summarized data to compilation worksheet.
Done.

MANUAL PREPROCESSING:
Create WorkDirectory
Move all InventoryWorksheets to WorkDirectory
Open and Create empty CompilationWorksheet, not in WorkDirectory

CODE:
Open InventoryWorksheet in WorkDirectory
Select and Copy target cell
GoTo A:100 and Paste
Select and Copy next target cell
GoTo B:100 and Paste
Iterate through all target cells incrementing columns
Select and Copy Row:100
Close InventoryWorksheet

GoTo CompilationWorksheet
Select Row:1 and Paste and Save

Iterate through all InventoryWorksheets incrementing CompilationWorksheet Row for each InventoryWorksheet.

End.

Any comments?

[LegareColeman]

Looks pretty good to me, assuming that there is a reason for iterating through the target cells rather than just copying them all at once.

[jharrisiii]

Re:copying them all at once...
The target cells are now laid out to look good as a printed form and are checkerboarded all over the InventoryWorksheet page.

I was so fixated on looping through the files that I overlooked on last obvious problem.

Each InventoryWorksheet has an ItemPicture. This also has to come across to the CompilationWorksheet. And to further twist the knife, I would like to set the SizeProperty to 5% before I copy it making it LineHeight tall.

Ifexist(secret.code), print, else kill.me

[jharrisiii]

<img src=/S/compute.gif border=0 alt=compute width=40 height=20> A bit of tinkering got me what I needed for the ItemPicture resize, copy, and paste.

Sub PictureResizeAndCopy()
'
' PictureResizeAndCopy Macro
'
'
On Error GoTo NoPicture
ActiveSheet.Shapes("Picture 1").Select
Selection.ShapeRange.ScaleHeight 0.05, True
Selection.ShapeRange.ScaleWidth 0.05, True
Selection.Copy
Windows("LineSheetData.xls").Activate
Application.Goto Reference:="R1C1"
ActiveSheet.Paste
NoPicture:
End Sub


Success is just a thousand iterations away...

[Mike Shea]

This worked great for me, Thanks.

This is what I ended up doing, if anyone is interested:

Dim FSO As New FileSystemObject

Dim strFName As Variant

Dim iCounter As Integer


strFName = Dir("S:Cerner ProjectStressTestStressTestCopy of *.csv", vbNormal)

While strFName <> ""


DoCmd.TransferText acImportDelim, "ctrain1 Import Specification", _
Mid$(FSO.GetBaseName(strFName), 9), "S:Cerner ProjectStressTestStressTest" & strFName

Debug.Print strFName

strFName = Dir()

iCounter = iCounter + 1
Wend