Excel VBA Input Box To Open Files

Question

I wonder whether someone may be able to help me please.

I've put together the following code which, via a 'Browse' window, allows a user to navigate to chosen files before extracting pertinent data from each, amalgamating them into a 'Summary' sheet.

Sub ConsolidateTimeRecording()

        Dim DestWB As Workbook
        Dim dR As Long
        Dim Fd As FileDialog
        Dim LastRow As Long
        Dim SourceSheet As String
        Dim sFile As String
        Dim sPath As String
        Dim StartRow As Long
        Dim wb As Workbook
        Dim ws As Worksheet

        Set DestWB = ActiveWorkbook

        SourceSheet = "Input"
        StartRow = 2

        Range("B4:N4").Select

        Selection.AutoFilter

           ' Select the folder that contains the files
        Set Fd = Application.FileDialog(msoFileDialogFolderPicker)
            With Fd
                '.InitialFileName = "DefaultPath"
                    If .Show = -1 Then
                        sPath = Fd.SelectedItems(1) & "\"
                    End If
            End With
        Set Fd = Nothing
            ' Directory in the folder
            sFile = Dir(sPath)
            Do While sFile <> ""

            Set wb = Workbooks.Open(Filename:=sFile, ReadOnly:=True, Password:="master")
                For Each ws In wb.Worksheets
                    If ws.Name = SourceSheet Then
                        With ws
                            If .UsedRange.Cells.count > 1 Then
                                dR = DestWB.Worksheets("Time Recording").Range("B" & DestWB.Worksheets("Time Recording").Rows.count).End(xlUp).Row + 1
                                If dR < 5 Then dR = 6  'destination start row
                                    LastRow = .Range("A" & Rows.count).End(xlUp).Row
                                    If LastRow >= StartRow Then
                                        .Range("A" & StartRow & ":M" & LastRow).Copy
                                        DestWB.Worksheets("Time Recording").Cells(dR, "B").PasteSpecial xlValues
                                        DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Name = "Lucida Sans"
                                        DestWB.Worksheets("Time Recording").Range("B5:N" & LastRow).Font.Size = 10
                                        DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).NumberFormat = "#,##0.00"
                                        DestWB.Worksheets("Time Recording").Range("K5:N" & LastRow).HorizontalAlignment = xlCenter
                                    End If
                                End If
                        End With
                Exit For
            End If
        Next ws
        wb.Close savechanges:=False
        ' Next file in folder
        sFile = Dir
      Loop

        Application.CutCopyMode = False

        msg = MsgBox("All Time Recording files have been consolidated", vbInformation)

        Columns("B:N").AutoFit
    End Sub

I'm now trying to amend this, but I'm a little unsure about how to progress this.

This is what I would like to achieve:

I would like to create a 'Input Box' allowing the user to enter the 'Month' for the folder they wish to open,
From this, I would then like to automatically open a sub folder called "Time Recording", before automatically extracting the data from the relevant 'Source' files using the existing code.

My file path to the folder containing the 'Source' files is as follows:

D:\Work Files\November\Time Recording

So when the Input Box is displayed it will at the "Work Files" level.

The user will then enter the month, in this example, "November".
Once they have entered the month name, the "Time Recording" folder will automatically open and the data from the'Source' files automatically extracted as per the existing code.

As I say, despite research around this, I'm a little unsure about how to make the amendments.

I just wondered whether someone may be able to look at this please and offer some guidancve on how I may go about achieving this.

Many thanks and kind regards

Excel VBA Input Box To Open Files

Answers (1)

Related Questions