vba to extract file names from other files in a folder

F

fillinspace

New member
Joined
Jan 12, 2016
Messages
4
Reaction score
0
Points
0
Hi All Genius Excel Gurus,

I am using the below code to extract data from various spreadsheets in a folder.

The code is running absolutely fine but I also need to get the name of the file in one of the columns of the destinations file.

Code: 
[COLOR=#333333]Sub Get_Info_By_Headers2()[/COLOR]
    Dim sPath As String    Dim sFil As String    Dim owb As Workbook    Dim twb As Workbook    Dim ch    Dim j As Long, a As Long, lr As Long    With Application        .Calculation = xlCalculationManual        .EnableEvents = False        .ScreenUpdating = False    End With    ch = Array("po number", "part number", "status", "quantity")    Set twb = ThisWorkbook    sPath = "C:\Users\dipak\Desktop\CRASH REPORT\"    sFil = Dir(sPath & "*.xl*")    Do While sFil <> "" And sFil <> twb.Name        Set owb = Workbooks.Open(sPath & sFil)            With owb.Sheets("data")                lr = twb.Sheets("report").Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row + 1                For j = LBound(ch) To UBound(ch)                                        a = .Rows(1).Find(ch(j), , , 1).Column                    .Range(.Cells(2, a), .Cells(.Cells(.Rows.Count, a).End(xlUp).Row, a)).Copy twb.Sheets("report").Cells(lr, j + 1)                Next j            End With        owb.Close False 'Close no save        sFil = Dir    Loop    With Application        .Calculation = xlAutomatic        .EnableEvents = True        .ScreenUpdating = True    End With [COLOR=#333333]End Sub[/COLOR]

Is there a way we I can get the name of the files in each row copied from each file?

Thanks in advance,
 
Hey fillinspace -- good question! Unfortunately it looks like your code copy / paste got screwed up, but from what I can tell the Workbook you're interested in is stored in owb (probably short for "opened work book").

Let's say your script is working on C:\Users\dipak\Desktop\CRASH REPORT\CoolReport.xlsx. Once this file is stored in the owb Workbook variable, you can take advantage of the Name and FullName methods:

Code: 
owb.Name

The above will return the string "CoolReport.xlsx".

Code: 
owb.FullName

The above will return the string "C:\Users\dipak\Desktop\CRASH REPORT\CoolReport.xlsx".

Now that you know how to use Name and FullName on owb, you can assign that to a cell wherever you'd like! Here's how you can write "CoolReport.xlsx" to cell A1 on the report sheet:

Code: 
twb.Sheets("report").Cells(1, 1) = owb.Name
 
Hi mate,

Thanks a lot for returning back to me with the solution. But you may not be happy to hear that I am bit of a dumb with coding. One of the friends helped me with the coding.

I am still not sure how I will be using the above code to extract file name in each row against the data retrieved from that file.

I believe I will have to modify the below line to extract that data properly.

Code: 
.Range(.Cells(2, a), .Cells(.Cells(.Rows.Count, a).End(xlUp).Row, a)).Copy twb.Sheets("report").Cells(Rows.Count, j + 1).End(xlUp).Offset(1)

May be in the last column E I need the file names against each row.

I know I am trying to spoon feed myself but I am still learning and the way you explained was the perfect I have ever been advised.

Thanks in advance again.
 

Attachments

  • MASTER WORKBOOK.xlsm
    22.7 KB · Views: 9
  • ata5.xlsx
    8.8 KB · Views: 6
  • DATA1.xlsx
    7.9 KB · Views: 6
  • data3.xlsx
    7.9 KB · Views: 5
Hi all,

I was able to get the closest result by adding some code as suggested by you.

However, I do not want to restrict the data only between bh2 to bh10. I want to take it from bh2 till the end of the last active row.

owb.Sheets("data").Range("bh2:bh10").Value = owb.Name

Please advise amendment to the above line.

Thanks.


Code: 
Sub Get_Info_By_Headers()
    Dim sPath As String
    Dim sFil As String
    Dim owb As Workbook
    Dim twb As Workbook
    Dim ch
    
    
    Dim j As Long, a As Long
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    ch = Array("po number", "part number", "status", "quantity", "project")
    Set twb = ThisWorkbook
    sPath = "C:\Users\dipak\Desktop\CRASH REPORT\"
    sFil = Dir(sPath & "*.xl*")
    Do While sFil <> "" And sFil <> twb.Name
        Set owb = Workbooks.Open(sPath & sFil)
            With owb.Sheets("data")
            owb.Sheets("DATA").Cells(1, 60) = "project"
            'owb.Sheets("DATA").Cells(2, 60) = owb.Name
            owb.Sheets("data").Range("bh2:bh10").Value = owb.Name
            
            
                lr = twb.Sheets("report").Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row + 1
                For j = LBound(ch) To UBound(ch)
                    a = .Rows(1).Find(ch(j), , , 1).Column
                    .Range(.Cells(2, a), .Cells(.Cells(.Rows.Count, a).End(xlUp).Row, a)).Copy twb.Sheets("report").Cells(lr, j + 1)
                    
                    Next j
            End With
        owb.Close False 'Close no save
        sFil = Dir
    Loop


    With Application
        .Calculation = xlAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
 
Are you familiar with autofilter & advancedfilter ?
 
Hey fillinspace -- good question, finding the last occupied row on a worksheet (or in a specific column on a worksheet) is a cornerstone of VBA programming.

Interestingly enough, it looks like you're already identifying the last row + 1 on the "report" Worksheet in ThisWorkbook here:
Code: 
lr = twb.Sheets("report").Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row + 1

So, using that as a guideline, this code, though untested, should identify the last row on the "data" Worksheet in owb:

Code: 
'at the top of your subroutine, where other variables are defined
Dim lngLastRowOnDataSheet As Long

'...

'After you've opened the "data"-containing workbook
With owb.Sheets("data")
    lngLastRowOnDataSheet = .Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
End With

Cool! You now have the number of the last row stored in lngLastRowOnDataSheet. Using this info, can then create a Range with two Cells like this (though again the code is untested):

Code: 
'at the top of your subroutine, where other variables are defined
Dim rngColumnToWriteFilenameTo As Range

'...

'After you've set the lngLastRowOnDataSheet variable, we will
'create a range using two Cells. As a note, column BH = 60
With owb.Sheets("data")
    Set rngColumnToWriteFilenameTo = .Range(.Cells(2, 60), .Cells(lngLastRowOnDataSheet, 60))
End With

Woohoo -- we're really close! All that's left to do is to assign the value to that Range:

Code: 
rngColumnToWriteFilenameTo.Value = owb.Name

And that should do it!
 
Wow, That worked like a charm. And the best part was the way you explained the concept. You are a Real Guru.

God Bless You.
 
You must log in or register to reply here.
Back
Top