Extract files in a folder without opening them

0

So Here is a new thread that I am curious to know, how to run through the files in a  folder containing .xlsm files without opening it and I have the path-to-folder hard coded in the code as I dont want  to browse the path every time in the dialog box.

Sub Report()
Dim myRange As Range, dates As Variant

Set myRange = Application.InputBox(Prompt:="Locate a single cell containing date of which this report should generate", _
    Title:="Reporting", Type:=8)
     'Application.WorksheetFunction.Count (ActiveSheet.myRange)
    If myRange.Cells.Count = 1 Then
        dates = myRange.Value  
    Else
        MsgBox "Enter a single cell"
    End If

Dim cnt1, cnt2, cnt3, cnt4, num1, num2, num3, num4    As Long    ' counter for matching cell values in column BI
Const DirName       As String = "C:\Users\\Offices\"
Const Ext           As String = "*.xlsm"    'File extension
Dim NextFn          As String               ' name of the next file to process
Dim SrcWb           As Workbook
Dim LastRow, i, FindRange     As Long

    NextFn = Dir(DirName & Ext)
     Do While NextFn <> ""
    
    Debug.Print NextFn                      ' for testing purposes (remove when done)
        Set SrcWb = Workbooks.Open(DirName & NextFn)

        cnt1 = Application.WorksheetFunction.CountIfs(Range("BI:BI"), "Andrew", Range("BJ:BJ"), dates)
        num1 = num1 + cnt1

        cnt2 = Application.WorksheetFunction.CountIfs(Range("BI:BI"), "Liss", Range("BJ:BJ"), dates)
        num2 = num2 + cnt2

        cnt3 = Application.WorksheetFunction.CountIfs(Range("BI:BI"), "Carry", Range("BJ:BJ"), dates)
        num3 = num3 + cnt3
        
        cnt4 = Application.WorksheetFunction.CountIfs(Range("BI:BI"), "Jafree", Range("BJ:BJ"), dates)
        num4 = num4 + cnt4
        
        NextFn = Dir
    Loop
    
    myRange.Offset(2, 0) = num1
    myRange.Offset(3, 0) = num2
    myRange.Offset(4, 0) = num3
    myRange.Offset(5, 0) = num4
Answer
Discuss

Discussion

If you don't say what you want to extract I can't show you how to extract it. Presuming that the files are all of the same structure please attach a sample file to your question.
Variatus (rep: 4148) May 29, '20 at 9:32 pm
As I have roughly written the code I pressume that would give an idea as a whole.
There are two files attached one is tracker file and the other is one of the multiple files for tracking(see column BI).

The motive here is to track the count of occurences of different users(appearing one or more times) in a column (BI) and record in a reporting tool based on the date choosen by the user. This task must be done in multiiple excel files(same structured) ,probably without opening it would be helpful.
Dr Liss (rep: 12) May 30, '20 at 12:51 pm
Please see my updated post
Dr Liss (rep: 12) May 30, '20 at 1:08 pm
Add to Discussion

Answers

0

Hello!

Sub ListFiles()
On Error GoTo Continua
Set folder = Application.FileDialog(msoFileDialogFolderPicker)
If folder.Show <> -1 Then Exit Sub
xDir = folder.SelectedItems(1)
Continua:
Call iListFilesInFolder(xDir, True)
End Sub

Function iListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
rowIndex = Application.ActiveSheet.Range("A65536").End(xlUp).Row + 1
For Each xFile In xFolder.Files
  Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Path
  rowIndex = rowIndex + 1
  strName = xFile.Path
Next xFile
If xIsSubfolders Then
  For Each xSubFolder In xFolder.SubFolders
    ListFilesInFolder xSubFolder.Path, True
  Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Function
Discuss
0

First, here is the code you have been so patient waiting for.

Function CountWork(ByVal Worker As String, _
                   ByVal Dat As Date) As Integer
    ' 039-4404

    Const DirName       As String = "F:\Shopping\Specialists\Master Copy\Daily list\Split files\Archive\"
    Const Ext           As String = "*.xlsm"    'File extension
    Const WsName        As String = "SHOPPING LISTING"
    Const SrcClm        As String = "BI"        ' change as required
    Const FirstDataRow  As Long = 5             ' change as required

    Dim Fun             As Integer              ' function return value
    Dim NextFn          As String               ' name of the next file to process
    Dim Wb              As Workbook             ' workbook(NextFn)
    Dim Ws              As Worksheet            ' working tab
    Dim Rng             As Range                ' BI:BJ
    Dim C               As Long                 ' translation of SrcClm

    C = Columns(SrcClm).Column
    NextFn = Dir(DirName & Ext)
    Application.ScreenUpdating = False
    Do While NextFn <> ""
        Set Wb = Workbooks.Open(DirName & NextFn, ReadOnly:=True)
        On Error Resume Next
        Set Ws = Wb.Worksheets(WsName)
        If Err = 0 Then
            With Ws
                Set Rng = .Range(.Cells(FirstDataRow, C), _
                                 .Cells(.Rows.Count, C).End(xlUp).Offset(, 1))
                Fun = Fun + Application.WorksheetFunction.CountIfs( _
                                  Rng.Columns(1), Worker, Rng.Columns(2), Dat)
            End With
        End If

        Application.DisplayAlerts = False
        Wb.Close False
        Application.DisplayAlerts = True

        NextFn = Dir
    Loop

    Application.ScreenUpdating = True
    CountWork = Fun
End Function

I didn't succeed avoiding the opening of files. Below please find a small procedure you can use for testing, as I did.

Sub RunCountWork()

'    Dim Worker As String
'    Dim Dat As Date
'
'    Worker = "Andrew"
'    Dat = #1/12/2020#
'      Debug.Print CountWork(Worker, Dat)
    Debug.Print CountWork(Range("A6").Value, Range("C3").Value)
End Sub

At first, I entered values against declared variables. Then I replaced the variables with cell references in the function call. Both methods work. Observe that the cell references are taken from the ActiveSheet (no worksheet specified).

The code takes the count using the COUNTIFS worksheet function on columns BI:BJ. A procedure to create the two columns from the one existing is contained in the attached workbook. I'm glad you decided to make this change. It will greatly facilitate your work going forward.

Now, as you will see, the function is slow, even with only 3 files to check as I had in my tests. You should design a system to minimize running the code repetitively. The workflow will determine the efficiency of the code's deployment. This subject clearly breaks the limits of what we can do here, in one thread. Please post a new question if you need assistance with deploying the code I provide here.

To give you a test of what's to come, please study cell formatting, especially Custom formats for dates. You will learn that you don't need your fields "First date" and "Last Date". Everybody knows which is the first day of January, or the last, and Excel knows it better even than most people. Accordingly, your plan should be that you enter "2020" in A3 and all dates in the sheet change to that year. To create a new year, you want to change only that one cell.

So, A2 has the formula =DATE(A3, 1, 1) with a custom cell format of "mmmm". [C2] = IF(month(A2+1) = month(A2),A2+1,"") with a custom cell format of "ddd". [C3] =C2, but a cell format like "d mmm yy" or "d/m/yyyy" as you have it now. C2:C3 can be copied all the way to the right (after you fix the problem I shall mention next) and down to C12:C13 and again to the right from there.

For A12 I recommend the formula =DateAdd("m", 1, A2), [A13] =A12 but with a custom cell format of "yyyy". A12:A13 can be copied down to the next month because the distance from one month to the next should be maintained as same (even if you have some blank rows as staff changes) or you look for some more demanding formulas to support copying with different staff strength.

With this system you would have the frist day of each month in column A. I don't know why you are interested in the last day but it can either be read from the last non-blank cell in row 2 or it can be calculated from the value in A2  with this formula =DateAdd("m",1,A2)-1.

My final salvo today is against the use of merged cells. Your design is far too demanding to allow for merging cells. There is too high a price to pay. Note that the value of a merged range is contained in its first cell. In your sheet A2:B2 is merged and the value appears in B2. But that's done by formatting. Excel finds the value in A2 and that prevents you from copying formulas efficiently. You find yourself forced to create a formula specially for column C which you can't copy to the right. It's the curse of the merged cell.

The alternative to merging cells is to use cell formatting. Delete column A, make column B wider and set the horizontal alignment Left with a large indent (perhaps 5 or 7). Everything will look the same but without the trouble. Note that the size of the indent depends on the total width of the column. An indent of 1 will be very small in a narrow column and uch bigger if the column is wide.

The exact arrangement of the worksheet will support automatic application of the code I'm providing today, and automation will support the workflow. You can't have an efficient whole if the parts don't match. We don't know yet how the final result will work but we do know that we don't want to be hampered by TEXT where dates should be or merged columns that will eat our time and the worksheet's efficiency, making it second-rate even before you can finish imagining it.

Discuss

Discussion

Thanks Variatus,understood your point but making changes by splitting column BI would dirupt the process of creating shopping listing sheet.
Although I can answer your question regarding the string format in BI, it is the change event macro, when a cell in column N is changed inturn it triggers to write the string(username+date) on column BI.So this format is fixed.

Having said that, will this be feasible to continue working using countif function,
Dr Liss (rep: 12) May 31, '20 at 3:54 am
I understand your point but it's a big mistake. So, let me have one more try. I could give you code to split the column in two on all existing files and amend your event procedure to create new data in two columns, too.
If you can't take advantage of that please post the line of code, from the event procedure you mention, that creates the entry in a single column.
Variatus (rep: 4148) May 31, '20 at 7:19 am
Hi! 
I managed to add a new column next to column BI and changed event procedure as well .Thank you for your help Variatus.Also I learnt about countif/countifs function and modified code accordingly in the post above.Could you take a look to check if there is any scope for improvement.
Dr Liss (rep: 12) Jun 2, '20 at 9:27 am
Wow this just so informative and I can actually use this in all my upcoming projects.Thank you so much for your time Variatus.

I prepared the tracker as you insisted.Regarding date in A12 the formula =DateAdd("m", 1, A2) did not work instead I used =EDATE(A2,1) which worked fine and you were right about merged cells I modified eliminating column A.

Thanks again for the code you provided,although I need to know how it is deployed in main program by calling CountWork().
Dr Liss (rep: 12) Jun 3, '20 at 6:29 am
Good morning Dr Liss,
We must close this thread. It's too long and too boring for all but ourselves. You are right. Now we must think of the macro that uses the macro, and for that we must focus on the work flow. Are you going to do this daily or monthly? Please prepare your question and ask it separate from here. This morning I thought that the function I wrote should be called vertically instead of horizontally. I mean, open a workbook and take out all the counts. Then open another workbook and add the results from there. That would save a lot of time but to look up 5 names once a day wouldn't make it worth the effort.
Variatus (rep: 4148) Jun 3, '20 at 7:20 pm
Thank you so much for your time and support.This really helped me to learn and I can further implement in my upcoming projects.

Regarding the tracker templte, I followed the instruction as you insisted but the formula for A12 =DateAdd("m", 1, A2) didnt work so I used =EDATE(A2,1) which worked fine and you were right about the problem with merged cells.

Thanks again for the codes Variatus.Although I would love to know how this function is called in main subprocedure.
Dr Liss (rep: 12) Jun 4, '20 at 1:32 am
The function call is demonstrated in the small sub RunCountWork. You might write code like 
ActiveSheet.Cells(10, 4).Value = CountWork(Range("A6").Value, Range("C3").Value)
which would place the result in cell D10. More likely, you would write code where A6 and C3 are variable (dependent upon the location of D10) and then call it in a loop to write results in, for example, all the cells associated with one day.
Variatus (rep: 4148) Jun 4, '20 at 1:58 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login