RedstoneIT
asked on
Add directory path to script
andrewssd3 provided the following wonderful script that is going to save huge amounts of time.
Currently the script is hard coded to one path, Const cstrDataLoc As String = "G:\Database work for Chad\Time" ' starting location of search
I'd like the script to prompt for the starting path and work from that point. For example, If I select c:\database\time\123 as my starting point, that it would use that instead of the hard coded path.
The script source code is shown below:
As I explained to Andrew on my previous question, I am not very knowledgeable about scripting and macros.
This is the source code Andrew created for me.
Option Explicit
Private mwbkMaster As Excel.Workbook ' this totals workbook
Private mrngEQOut As Excel.Range ' next available cell for totals for EQ
Private mrngLabOut As Excel.Range ' next available cell for totals for Labor
Private mobjFSO As Object 'object 'Scripting.FileSystemObjec
Public Sub ImportAll()
Dim shtEQTot As Excel.Worksheet
Dim shtLabTot As Excel.Worksheet
Dim fldMaster As Object 'Scripting.Folder
Dim fldSub As Object 'Scripting.Folder
Dim filData As Object 'Scripting.File
Const cstrDataLoc As String = "G:\Database work for Chad\Time" ' starting location of search
Set mwbkMaster = ThisWorkbook
' get the EQ totals sheet and find the first available row
Set shtEQTot = mwbkMaster.Worksheets("EQ Totals")
Set mrngEQOut = shtEQTot.UsedRange
Set mrngEQOut = mrngEQOut.Offset(mrngEQOut
' get the Labor totals sheet and find the first available row
Set shtLabTot = mwbkMaster.Worksheets("Lab
Set mrngLabOut = shtLabTot.UsedRange
Set mrngLabOut = mrngLabOut.Offset(mrngLabO
' create the file system object
Set mobjFSO = CreateObject("Scripting.Fi
' find the master folder
Set fldMaster = mobjFSO.GetFolder(cstrData
' loop through all the sub folders
For Each fldSub In fldMaster.SubFolders
' loop through all the files (should be only one?)
For Each filData In fldSub.Files
' check it's some sort of Excel file and process it
If LCase$(mobjFSO.GetExtensio
Call ProcessFile(filData.Path)
End If
Next filData
Next fldSub
Set mrngEQOut = Nothing
Set mrngLabOut = Nothing
Set mobjFSO = Nothing
MsgBox "Completed"
End Sub
Private Sub ProcessFile(ByVal strPath As String)
' called once for each workbook found
Dim wbkIndiv As Excel.Workbook
Dim wksCurrIn As Excel.Worksheet
Dim rngIn As Excel.Range
Dim strCaption As String ' the name of the current input workbook
Dim aData As Variant
strCaption = mobjFSO.GetBaseName(strPat
' open the data workbook
Set wbkIndiv = Application.Workbooks.Open
UpdateLinks:=False, ReadOnly:=True, addtomru:=False)
' get the first sheet
Set wksCurrIn = wbkIndiv.Worksheets("EQ Totals")
' get all data for this sheet into an array
Set rngIn = wksCurrIn.UsedRange
aData = rngIn.Value
' prepare the output range by making it the right size to receive the data
Set mrngEQOut = mrngEQOut.Resize(rngIn.Row
' put in the values from the input sheet
mrngEQOut.Value = aData
' put in the label identifying this row
mrngEQOut.Offset(0, -1).Resize(mrngEQOut.Rows.
' get the next sheet (NB this is the same as the previous sheet - left separate
' in case something needs to change at a later point for one sheet
Set wksCurrIn = wbkIndiv.Worksheets("Labor
' get all data for this sheet into an array
Set rngIn = wksCurrIn.UsedRange
aData = rngIn.Value
' prepare the output range by making it the right size to receive the data
Set mrngLabOut = mrngLabOut.Resize(rngIn.Ro
' put in the values from the input sheet
mrngLabOut.Value = aData
' put in the label identifying this row
mrngLabOut.Offset(0, -1).Resize(mrngLabOut.Rows
'move the output ranges on
Set mrngEQOut = mrngEQOut.Offset(mrngEQOut
Set mrngLabOut = mrngLabOut.Offset(mrngLabO
wbkIndiv.Saved = True
' close the data workbook
Application.DisplayAlerts = False
wbkIndiv.Close xlDoNotSaveChanges
Application.DisplayAlerts = True
End Sub
Currently the script is hard coded to one path, Const cstrDataLoc As String = "G:\Database work for Chad\Time" ' starting location of search
I'd like the script to prompt for the starting path and work from that point. For example, If I select c:\database\time\123 as my starting point, that it would use that instead of the hard coded path.
The script source code is shown below:
As I explained to Andrew on my previous question, I am not very knowledgeable about scripting and macros.
This is the source code Andrew created for me.
Option Explicit
Private mwbkMaster As Excel.Workbook ' this totals workbook
Private mrngEQOut As Excel.Range ' next available cell for totals for EQ
Private mrngLabOut As Excel.Range ' next available cell for totals for Labor
Private mobjFSO As Object 'object 'Scripting.FileSystemObjec
Public Sub ImportAll()
Dim shtEQTot As Excel.Worksheet
Dim shtLabTot As Excel.Worksheet
Dim fldMaster As Object 'Scripting.Folder
Dim fldSub As Object 'Scripting.Folder
Dim filData As Object 'Scripting.File
Const cstrDataLoc As String = "G:\Database work for Chad\Time" ' starting location of search
Set mwbkMaster = ThisWorkbook
' get the EQ totals sheet and find the first available row
Set shtEQTot = mwbkMaster.Worksheets("EQ Totals")
Set mrngEQOut = shtEQTot.UsedRange
Set mrngEQOut = mrngEQOut.Offset(mrngEQOut
' get the Labor totals sheet and find the first available row
Set shtLabTot = mwbkMaster.Worksheets("Lab
Set mrngLabOut = shtLabTot.UsedRange
Set mrngLabOut = mrngLabOut.Offset(mrngLabO
' create the file system object
Set mobjFSO = CreateObject("Scripting.Fi
' find the master folder
Set fldMaster = mobjFSO.GetFolder(cstrData
' loop through all the sub folders
For Each fldSub In fldMaster.SubFolders
' loop through all the files (should be only one?)
For Each filData In fldSub.Files
' check it's some sort of Excel file and process it
If LCase$(mobjFSO.GetExtensio
Call ProcessFile(filData.Path)
End If
Next filData
Next fldSub
Set mrngEQOut = Nothing
Set mrngLabOut = Nothing
Set mobjFSO = Nothing
MsgBox "Completed"
End Sub
Private Sub ProcessFile(ByVal strPath As String)
' called once for each workbook found
Dim wbkIndiv As Excel.Workbook
Dim wksCurrIn As Excel.Worksheet
Dim rngIn As Excel.Range
Dim strCaption As String ' the name of the current input workbook
Dim aData As Variant
strCaption = mobjFSO.GetBaseName(strPat
' open the data workbook
Set wbkIndiv = Application.Workbooks.Open
UpdateLinks:=False, ReadOnly:=True, addtomru:=False)
' get the first sheet
Set wksCurrIn = wbkIndiv.Worksheets("EQ Totals")
' get all data for this sheet into an array
Set rngIn = wksCurrIn.UsedRange
aData = rngIn.Value
' prepare the output range by making it the right size to receive the data
Set mrngEQOut = mrngEQOut.Resize(rngIn.Row
' put in the values from the input sheet
mrngEQOut.Value = aData
' put in the label identifying this row
mrngEQOut.Offset(0, -1).Resize(mrngEQOut.Rows.
' get the next sheet (NB this is the same as the previous sheet - left separate
' in case something needs to change at a later point for one sheet
Set wksCurrIn = wbkIndiv.Worksheets("Labor
' get all data for this sheet into an array
Set rngIn = wksCurrIn.UsedRange
aData = rngIn.Value
' prepare the output range by making it the right size to receive the data
Set mrngLabOut = mrngLabOut.Resize(rngIn.Ro
' put in the values from the input sheet
mrngLabOut.Value = aData
' put in the label identifying this row
mrngLabOut.Offset(0, -1).Resize(mrngLabOut.Rows
'move the output ranges on
Set mrngEQOut = mrngEQOut.Offset(mrngEQOut
Set mrngLabOut = mrngLabOut.Offset(mrngLabO
wbkIndiv.Saved = True
' close the data workbook
Application.DisplayAlerts = False
wbkIndiv.Close xlDoNotSaveChanges
Application.DisplayAlerts = True
End Sub
you could get rid of this line
Const cstrDataLoc As String = "G:\Database work for Chad\Time" ' starting location of search
And in the code put something like
strDataLoc = Input("please enter the path of the directory")
replace this line
Set fldMaster = mobjFSO.GetFolder(cstrData
with
Set fldMaster = mobjFSO.GetFolder(strDataL
Const cstrDataLoc As String = "G:\Database work for Chad\Time" ' starting location of search
And in the code put something like
strDataLoc = Input("please enter the path of the directory")
replace this line
Set fldMaster = mobjFSO.GetFolder(cstrData
with
Set fldMaster = mobjFSO.GetFolder(strDataL
whoops missed out a bit
you could get rid of this line
Const cstrDataLoc As String = "G:\Database work for Chad\Time" ' starting location of search
And in the code put something like
Dim strDataLoc as string
strDataLoc = InputBox("please enter the path of the directory")
replace this line
Set fldMaster = mobjFSO.GetFolder(cstrData
with
Set fldMaster = mobjFSO.GetFolder(strDataL
you could get rid of this line
Const cstrDataLoc As String = "G:\Database work for Chad\Time" ' starting location of search
And in the code put something like
Dim strDataLoc as string
strDataLoc = InputBox("please enter the path of the directory")
replace this line
Set fldMaster = mobjFSO.GetFolder(cstrData
with
Set fldMaster = mobjFSO.GetFolder(strDataL
ASKER
ok, the solutions provided would work, but this will be used by users who will not know how to find the path except by browsing. Is there a way to allow them to select the directory from a browser such as a common dialog box or something?
ASKER
I just tried the solutions and it is not importing the information from the folder location like it does if the location is static
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Chris,
I'[m getting a variable not defined error on function getpath
I'[m getting a variable not defined error on function getpath
ASKER
Wobbled, your code is working when I chose the original hard coded path, but when I select other paths it doesnt import the xls files.
ASKER
Ok Wobbled I figured out the problem. Its looking for sub folders under the main folder. without them it doesn't see the excel files in the folder.
I'll open up that problem as a new question.
Thank you all for responding.
I'll open up that problem as a new question.
Thank you all for responding.
glad to have helped :)
I actually took the comment script too literally and assumed it was for a VB Script! A look at the block I cut and pasted would have corrected me ... but I didn't do it.
Chris
Chris
Const cstrDataLoc As String = "G:\Database work for Chad\Time" ' starting location of search
to
Dim cstrDataLoc As String
cstrDataLoc= InputBox ("Please Enter the starting Point of your Process")
HTH