Results 1 to 5 of 5

Thread: Issue w/Script to Import Data from Files in Folder

  1. #1

    Thread Starter
    New Member
    Join Date
    Apr 2018
    Posts
    2

    Resolved Issue w/Script to Import Data from Files in Folder

    I'm a novice at VB and macros, and am in the process of developing a script that will automatically pull in data from Excel files in a specified directory.

    The script I currently made, is able to pull data from 3 separate sheets from workbooks located in a specified folder. The issue is that some of the sheets can contain hundreds of rows of data, and others only a few. My script currently only pulls in the first two rows, and I am looking for advice on how to modify the script to pull in all rows of a given sheet (if there is data present of course).

    This is what I have so far:



    Sub Enrollment Survey() Dim strfile As String Dim sourcewb As Workbook Dim ModifiedDate As String Dim SheetArray As Variant Dim i As Integer Dim j As Integer

    Application.ScreenUpdating = False

    'Folder location, CHANGE FOLDER
    strfile = Dir("I:\FOLDER\FOLDER\*.xlsx")

    'Sheets array
    SheetArray = Array("Sheet 1", "Sheet 2", "Sheet 3")
    i = 0
    j = UBound(SheetArray)

    'Set cell and sheets for paste
    ThisWorkbook.Sheets("Enrollment").Activate
    ThisWorkbook.Sheets("Enrollment").Range("B4").Activate

    'File modified date
    Set oFS = CreateObject("Scripting.FileSystemObject")
    ActiveCell = oFS.GetFile("I:\FOLDER\FOLDER\" & strfile).DateLastModified

    'Copy Paste Loop for each file
    Do While Len(strfile) > 0
    'Open Sourse Workbook, CHANGE FOLDER
    Set sourcewb = Workbooks.Open("I:\FOLDER\FOLDER\" & strfile)


    For i = 0 To j
    'This part can be remove if not needed. Copies the file name and paste it in the workbook so you know where the numbers came from
    ThisWorkbook.Activate
    ActiveCell = strfile
    ActiveCell.Offset(0, -1) = oFS.GetFile("I:\FOLDER\FOLDER\" & strfile).DateLastModified
    ActiveCell.Offset(1, 0) = strfile
    ActiveCell.Offset(1, -1) = oFS.GetFile("I:\FOLDER\FOLDER\" & strfile).DateLastModified
    ActiveCell.Offset(0, 1) = SheetArray(i)
    ActiveCell.Offset(0, -1) = oFS.GetFile("I:\FOLDER\FOLDER\" & strfile).DateLastModified
    ActiveCell.Offset(1, 1) = SheetArray(i)
    ActiveCell.Offset(0, -1) = oFS.GetFile("I:\FOLDER\FOLDER\" & strfile).DateLastModified
    'End for file identifier

    'Copy Paste Part

    sourcewb.Sheets(SheetArray(i)).Activate
    Range("B8:I400").Copy
    ThisWorkbook.Activate
    ActiveCell.Offset(0, 2).PasteSpecial Transpose:=True
    Application.CutCopyMode = False
    ActiveCell.Offset(2, -2).Select
    Next i

    'Error handling
    On Error Resume Next

    'Close workbook
    sourcewb.Close False
    strfile = Dir

    Loop
    Application.ScreenUpdating = True
    End Sub

    Any help would be greatly appreciated! Thanks!
    Last edited by Boberts227; Apr 19th, 2018 at 07:35 AM.

  2. #2
    Super Moderator si_the_geek's Avatar
    Join Date
    Jul 2002
    Location
    Bristol, UK
    Posts
    41,929

    Re: Issue w/Script to Import Data from Files in Folder

    Welcome to VBForums

    Thread moved from the 'VBScript' forum to the 'Office Development/VBA' forum.

    Note that while it certainly isn't made clear, the "VB Editor" in Office programs is actually VBA rather than VB or VBScript

  3. #3
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Issue w/Script to Import Data from Files in Folder

    first avoid use of select or activate, or working with activecell, active anything else or selection as far as possible

    i do not understand why you are using FSO for anything, when you are already working with vb inbuilt file i/o functions like DIR
    you can get the last saved date from within each workbook

    My script currently only pulls in the first two rows,
    this does not appear to be correct, as you are copying range B8:I400, then transposing when you paste, so should have 8 rows of new data, but the next sheet data will overwrite it all except the first two rows, though i am not sure that you really want to transpose, in which case you would have 398 rows of data

    there would be several choices to resolve this, always find the last row of data and write to the next row
    find the last row of data from the source, then add the number of rows to a tally to know where to write the data

    Code:
    set target = thisworkbook.sheets("enrolment")  ' chnage to suit
    strfile = Dir("I:\FOLDER\FOLDER\*.xlsx")
    
    'Sheets array
    SheetArray = Array("Sheet 1", "Sheet 2", "Sheet 3")
    
    
    
    'Copy Paste Loop for each file
    Do While Len(strfile) > 0
      'Open Sourse Workbook, CHANGE FOLDER
      Set sourcewb = Workbooks.Open("I:\FOLDER\FOLDER\" & strfile)
    
    
      For i = 0 To ubound(sheetarray)
    
      'Copy Paste Part
        with sourcewb.Sheets(SheetArray(i)) 
           lastrow = .cells(.rows.count, 2).end(xlup).row   ' last row column 2
           datatocopy =.cells(8, 2).resize(lastrow - 8, 8)   ' this should be B8:I lastrow of data, check my math
        end with
        ' assign data to next empty row in worksheet for however many rows and columns
        target.cells(rows.count, 4).end(xlup).offset(1).resize(ubound(datatocopy, 1), ubound(datatocopy, 2)) = datatocopy
      Next i
    
      'Close workbook
       sourcewb.Close False
      strfile = Dir
    
    Loop
    this is completely untested and does not include putting the last saved date into the worksheet, i placed the data into column D, but am not sure if that was correct, very easy to change if not, again i was not sure which cells you wanted the last save date, so i left them out
    i assigned the values directly to the cells without using copy paste, no need to take over the users clipboard
    as i typed this directly in the browser, it may contain typos or code errors
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  4. #4

    Thread Starter
    New Member
    Join Date
    Apr 2018
    Posts
    2

    Re: Issue w/Script to Import Data from Files in Folder

    Great. Thank you very much for your assistance! I see where I went wrong and was able to rectify the issue. Thanks again!

  5. #5
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Issue w/Script to Import Data from Files in Folder

    if it is all good now, pls mark the thread resolved
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

Posting Permissions

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



Click Here to Expand Forum to Full Width