-
Apr 17th, 2018, 08:07 PM
#1
Thread Starter
New Member
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.
-
Apr 18th, 2018, 05:40 PM
#2
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
-
Apr 19th, 2018, 05:49 AM
#3
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
-
Apr 19th, 2018, 07:36 AM
#4
Thread Starter
New Member
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!
-
Apr 19th, 2018, 04:09 PM
#5
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|