Results 1 to 12 of 12
  1. #1
    Lounger
    Join Date
    Apr 2002
    Location
    Los Angeles, California, USA
    Posts
    36
    Thanks
    0
    Thanked 0 Times in 0 Posts

    1000+ File data extract (97 sr2)

    <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
    Attached Files Attached Files

  2. #2
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts

    Re: 1000+ File data extract (97 sr2)

    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)
    Attached Files Attached Files

  3. #3
    Lounger
    Join Date
    Apr 2002
    Location
    Los Angeles, California, USA
    Posts
    36
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: 1000+ File data extract (97 sr2)

    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>

  4. #4
    Lounger
    Join Date
    Mar 2002
    Posts
    28
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: 1000+ File data extract (97 sr2)

    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.

  5. #5
    4 Star Lounger
    Join Date
    Jan 2001
    Location
    Kortrijk, Belgium
    Posts
    571
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: 1000+ File data extract (97 sr2)

    This post might help you starting as well.

  6. #6
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: 1000+ File data extract (97 sr2)

    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>

    Legare Coleman

  7. #7
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts

    Re: 1000+ File data extract (97 sr2)

    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.
    Attached Files Attached Files

  8. #8
    Lounger
    Join Date
    Apr 2002
    Location
    Los Angeles, California, USA
    Posts
    36
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: 1000+ File data extract (97 sr2)

    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?

  9. #9
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: 1000+ File data extract (97 sr2)

    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.
    Legare Coleman

  10. #10
    Lounger
    Join Date
    Apr 2002
    Location
    Los Angeles, California, USA
    Posts
    36
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: 1000+ File data extract (97 sr2)

    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

  11. #11
    Lounger
    Join Date
    Apr 2002
    Location
    Los Angeles, California, USA
    Posts
    36
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: 1000+ File data extract (97 sr2)

    <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...

  12. #12
    3 Star Lounger
    Join Date
    Jan 2001
    Location
    Serbia and Montenegro (Yugoslavia)
    Posts
    342
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: 1000+ File data extract (97 sr2)

    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •