mongoose
07-07-2019, 04:13 PM
What I am trying to do here is pull file names, sort them after parsing their file name (using SELECT to define the different values I am looking for), then transfer those filenames as an array over to each relevant sheet in the workbook.
I had a somewhat working function but it was really slow. After receiving some advice I decided to send the results to an array then use VBA to transfer values directly to worksheets; this is what I have so far.
PublicSub GetSOPFiles()
' Set folder path
Const FolderPath AsString="C:\Users\test\Desktop\SOP Audit Excel Prototype"
Const FileExt AsString="docx"
Dim Result AsVariant
Dim i AsInteger
Dim MyFile AsObject
Dim MyFSO AsObject
Dim MyFolder AsObject
Dim MyFiles AsObject
Dim dept AsVariant
Dim deptCodes()AsVariant
Set MyFSO = CreateObject("Scripting.FileSystemObject")
Set MyFolder = MyFSO.GetFolder(FolderPath)
Set MyFiles = MyFolder.Files
' Research built-in Result function in VBA
ReDim Result(1To MyFiles.Count)
Dim vData AsVariant
Dim sTemp AsVariant
' Use a For loop to loop through the total number of sheets
For i =1To12
' Setup Select to determine dept values
SelectCase i
Case1
deptCodes = Array("PNT","VLG","SAW")
Case2
deptCodes = Array("CRT","AST","SHP","SAW")
Case3
deptCodes = Array("CRT","STW","CHL","ALG","ALW","ALF","RTE","AFB","SAW")
Case4
deptCodes = Array("SCR","THR","WSH","GLW","PTR","SAW")
Case5
deptCodes = Array("PLB","SAW")
Case6
deptCodes = Array("DES")
Case7
deptCodes = Array("AMS")
Case8
deptCodes = Array("EST")
Case9
deptCodes = Array("PCT")
Case10
deptCodes = Array("PUR","INV")
Case11
deptCodes = Array("SAF")
Case12
deptCodes = Array("GEN")
EndSelect
' Loop through files in directory
j =0
ForEach MyFile In MyFiles
' Limit files by file extension
If InStr(1, MyFile.Name, FileExt)<>0Then
' Explode file name into array and only pull files with defined dept codes
Dim toSplitFileName AsVariant
toSplitFileName = Split(MyFile.Name,"-")
ForEach dept In deptCodes
If dept = toSplitFileName(3)Then
ReDimPreserve Result(0To j)
Result(j)= MyFile.Name
j = j +1
EndIf
' Send array to worksheet
Range("A1:A"& j).Value = Application.WorksheetFunction.Transpose(Result)
Next dept
EndIf
Next MyFile
Next
EndSub
I'm trying to figure out how I could send the data to each sheet now. Say it loops through and finds all the files for SELECT Case 1, it sends all of those filenames to column A in Sheet 1. Same for Case 2, etc.
Thank you for your help everyone! After 3 book purchases and a lot of internet reading, I feel I'm starting to make some headway into VBA. Still have a lot to learn though.
I had a somewhat working function but it was really slow. After receiving some advice I decided to send the results to an array then use VBA to transfer values directly to worksheets; this is what I have so far.
PublicSub GetSOPFiles()
' Set folder path
Const FolderPath AsString="C:\Users\test\Desktop\SOP Audit Excel Prototype"
Const FileExt AsString="docx"
Dim Result AsVariant
Dim i AsInteger
Dim MyFile AsObject
Dim MyFSO AsObject
Dim MyFolder AsObject
Dim MyFiles AsObject
Dim dept AsVariant
Dim deptCodes()AsVariant
Set MyFSO = CreateObject("Scripting.FileSystemObject")
Set MyFolder = MyFSO.GetFolder(FolderPath)
Set MyFiles = MyFolder.Files
' Research built-in Result function in VBA
ReDim Result(1To MyFiles.Count)
Dim vData AsVariant
Dim sTemp AsVariant
' Use a For loop to loop through the total number of sheets
For i =1To12
' Setup Select to determine dept values
SelectCase i
Case1
deptCodes = Array("PNT","VLG","SAW")
Case2
deptCodes = Array("CRT","AST","SHP","SAW")
Case3
deptCodes = Array("CRT","STW","CHL","ALG","ALW","ALF","RTE","AFB","SAW")
Case4
deptCodes = Array("SCR","THR","WSH","GLW","PTR","SAW")
Case5
deptCodes = Array("PLB","SAW")
Case6
deptCodes = Array("DES")
Case7
deptCodes = Array("AMS")
Case8
deptCodes = Array("EST")
Case9
deptCodes = Array("PCT")
Case10
deptCodes = Array("PUR","INV")
Case11
deptCodes = Array("SAF")
Case12
deptCodes = Array("GEN")
EndSelect
' Loop through files in directory
j =0
ForEach MyFile In MyFiles
' Limit files by file extension
If InStr(1, MyFile.Name, FileExt)<>0Then
' Explode file name into array and only pull files with defined dept codes
Dim toSplitFileName AsVariant
toSplitFileName = Split(MyFile.Name,"-")
ForEach dept In deptCodes
If dept = toSplitFileName(3)Then
ReDimPreserve Result(0To j)
Result(j)= MyFile.Name
j = j +1
EndIf
' Send array to worksheet
Range("A1:A"& j).Value = Application.WorksheetFunction.Transpose(Result)
Next dept
EndIf
Next MyFile
Next
EndSub
I'm trying to figure out how I could send the data to each sheet now. Say it loops through and finds all the files for SELECT Case 1, it sends all of those filenames to column A in Sheet 1. Same for Case 2, etc.
Thank you for your help everyone! After 3 book purchases and a lot of internet reading, I feel I'm starting to make some headway into VBA. Still have a lot to learn though.