PDA

View Full Version : Extraction amounts for each file name based on firs part in file name



Alaa
05-04-2025, 01:45 AM
Hello
I have file in folders and subfolders within this device "D:\REPORT\DATA"
so the files in folder and subfolders like this "D:\REPORT\DATA\PAID INVOICE NO 54,300.00"
"D:\REPORT\DATA\REPORT\RECEIVED INVOICE NO 15,056.00
most of extension for all of files will be excel All kinds .
the result will be in OUTPUT file is open to run the macro
the macro should do
1- make headers (ITEM,NAME FILE,MONTH ,RECEIVED,PAID)
2- auto number in column A
3- brings file names from folders, subfolders without extensions in column B.
4-brings month number in column C based on modified date in column C.
5-brings amount based on PAID , RECEIVED are existed in file name.
6- ignore any file doesn't contain PAID,RECEIVED words.
7- I expect to reach files counts could be 100 files through year .
8- should insert TOTAL row to sum column D,E
9- every time run the macro should replace data for OUTPUT file.
10- finally without forgetting numbers formatting.
I hope finding help from experts.

Aussiebear
05-04-2025, 03:54 AM
Welcome to VBAX Alaa. Normally speaking when members post threads, they are for singular items of interest. This type of question is possibly reaching into an area where you might have to consider a paid service for assistance, if someone wanted to take it on as a project.

Alaa
05-04-2025, 04:03 AM
thanks for inform me .if there is no body to see my thread I will search for the code in the internet and try to adapt based on my requirements.

arnelgp
05-04-2025, 08:52 AM
where did you get the month number? there is no date on the excel file.

Aussiebear
05-04-2025, 12:25 PM
This is not tested, and follows your described requests in your first posts rather than the actual workbooks. As arnelgp has pointed out there are no specific dates in the files


Sub ExtractInvoiceData()
Dim fso As Object
' FileSystemObject
Dim topFolder As Object
' Folder object for the root directory
Dim subFolder As Object
' Folder object for subdirectories
Dim fileObj As Object
' File object
Dim outputSheet As Worksheet
Dim lastRow As Long
Dim i As Long
Dim fileName As String
Dim monthNumber As Integer
Dim amount As Double
Dim paidFound As Boolean
Dim receivedFound As Boolean
Dim nextRow As Long
' Set the folder to search
Const START_FOLDER As String = "D:\REPORT\DATA"
' Set the name of the output sheet (assuming it exists)
Const OUTPUT_SHEET_NAME As String = "Sheet1"
' Change if your sheet has a different name
' Create an instance of the FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
' Get the top-level folder
Set topFolder = fso.GetFolder(START_FOLDER)
' Set the output sheet
On Error Resume Next
' In case the sheet doesn't exist
Set outputSheet = ThisWorkbook.Sheets(OUTPUT_SHEET_NAME)
On Error GoTo 0
' If the output sheet doesn't exist, add one (you might want to handle this differently)
If outputSheet Is Nothing Then
Set outputSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Coun t))
outputSheet.Name = OUTPUT_SHEET_NAME
End If
' Clear existing data in the output sheet (except headers if they exist)
outputSheet.Cells.ClearContents
' Write the headers outputSheet.Cells(1, 1).Value = "ITEM"
outputSheet.Cells(1, 2).Value = "NAME FILE"
outputSheet.Cells(1, 3).Value = "MONTH"
outputSheet.Cells(1, 4).Value = "RECEIVED"
outputSheet.Cells(1, 5).Value = "PAID"
' Initialize the row counter
nextRow = 2 i = 1
' Function to recursively process folders
Sub ProcessFolders(folder As Object)
Dim subFldr As Object
Dim file As Object
Dim parts As Variant
' Loop through each file in the current folder
For Each file In folder.Files
' Check if the file name contains "PAID" or "RECEIVED"
If InStr(UCase(file.Name), "PAID") > 0 Or InStr(UCase(file.Name), "RECEIVED") > 0 Then
' Extract file name without extension
fileName = Left(file.Name, InStrRev(file.Name, ".") - 1)
' Get the month number from the file's modified date
monthNumber = Month(file.DateLastModified)
' Initialize amount and flags amount = 0
paidFound = False
receivedFound = False
' Extract amount based on "PAID" or "RECEIVED"
parts = Split(UCase(fileName), " ")
For Each part In parts
If part = "PAID" Then
paidFound = True
' Find the number after "PAID"
If IsNumeric(parts(UBound(Filter(parts, "PAID")) + 1)) Then
amount = CDbl(parts(UBound(Filter(parts, "PAID")) + 1))
ElseIf UBound(Filter(parts, ",")) > -1 Then
' Handle cases with comma as decimal separator
amount = CDbl(Replace(parts(UBound(Filter(parts, "PAID")) + 1)), ",", "."))
End If
ElseIf
part = "RECEIVED" Then
receivedFound = True
' Find the number after "RECEIVED"
If IsNumeric(parts(UBound(Filter(parts, "RECEIVED")) + 1)) Then
amount = CDbl(parts(UBound(Filter(parts, "RECEIVED")) + 1))
ElseIf UBound(Filter(parts, ",")) > -1 Then
' Handle cases with comma as decimal separator
amount = CDbl(Replace(parts(UBound(Filter(parts, "RECEIVED")) + 1)), ",", "."))
End If
End If
Next part
' Write the data to the output sheet
With outputSheet
.Cells(nextRow, 1).Value = i
.Cells(nextRow, 2).Value = fileName
.Cells(nextRow, 3).Value = monthNumber
If receivedFound Then
.Cells(nextRow, 4).Value = amount
End If
If paidFound Then
.Cells(nextRow, 5).Value = amount
End If
End With
' Increment counters
nextRow = nextRow + 1
i = i + 1
End If
Next file
' Recursively call this function for each subfolder
For Each subFldr In folder.SubFolders
ProcessFolders subFldr
Next subFldr
End Sub
' Start processing from the top folder ProcessFolders topFolder
' Add the TOTAL row
With outputSheet lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(lastRow + 1, 1).Value = "TOTAL"
.Cells(lastRow + 1, 4).Formula = "=SUM(D2:D" & lastRow & ")"
.Cells(lastRow + 1, 5).Formula = "=SUM(E2:E" & lastRow & ")"
' Apply number formatting
.Range("A2:A" & lastRow).NumberFormat = "0"
' Auto number
.Range("D2:E" & lastRow + 1).NumberFormat = "#,##0.00"
' Amount with two decimal places
End With
' Clean up object variables
Set fileObj = Nothing
Set subFolder = Nothing
Set topFolder = Nothing
Set fso = Nothing
MsgBox "Invoice data extraction complete!", vbInformation
End Sub

Alaa
05-04-2025, 01:16 PM
where did you get the month number? there is no date on the excel file.
I mentioned that

4-brings month number in column C based on modified date in column C.

each file contains modified date when show properties inside folders.

Alaa
05-04-2025, 01:20 PM
thanks Aussiebear
I will check your code and see how goes at work tomorrow .

Aussiebear
05-04-2025, 01:22 PM
That's an unusual method for accounting.

arnelgp
05-04-2025, 09:00 PM
see this demo also.