List files in a folder and capture one cell data from each?

[TheWennerWoman]

Hello, hope someone can help, I've got myself into a bit of a pickle with this

I have a folder, say, c:\users\test that contains a number of Excel files (*.xlsx). This will vary from month to month but let's say for this question it contains 1.xlsx, 2.xlsx, 3.xlsx (i.e three files).

What I want to do is loop through the folder and list the filename in Sheet1 column A. Then I want to open each file, capture the email address that is held on a tab named "emails" (cell A1) and then close the file.

The email address will go into Sheet1 column B.

My output would look something like this

1.xlsx donald.trump@whitehouse.gov.us
2.xlsx vladimir.putin@kremlin.ru
3.xlsx bill.gates@microsoft.com

Is this do-able?

Many thanks!

 

[nemmi69]

try

Sub LoopThroughFiles()

Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim Fcount As Integer
Dim StrtRow As Integer
Dim StrtCol As Integer

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = oFSO.GetFolder("C:\MyWork")
StrtRow = 21
StrtCol = 1
Fcount=0

For Each oFile In oFolder.Files
    If Right(oFile.Name, 4) = "xlsx" Then
        Cells(StrtRow, StrtCol) = oFile.Name
        StrtRow = StrtRow + 1
        Fcount = Fcount + 1
    End If
Next oFile
End Sub

 

[Herakles]

Most things are doable.

Try this.

Private Sub subGetEmailAddresse()
Dim WbActive As Workbook
Dim intLastRow As Integer
Dim strFile As String
Dim strPath As String
Dim intCounter As Integer

    strPath = "c:\users\test\"
    
    Set WbActive = ActiveWorkbook
    
    Application.ScreenUpdating = False
    
    strFile = Dir(strPath & "*.xlsx")
        
    While strFile <> vbNullString
    
        intCounter = intCounter + 1
    
        Workbooks.Open filename:=strPath & strFile
        
        intLastRow = WbActive.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
        
        WbActive.Sheets("Sheet1").Cells(intLastRow, 1).Value = strFile

        WbActive.Sheets("Sheet1").Cells(intLastRow, 2).Value = ActiveWorkbook.Sheets("Sheet1").Range("A1").Value
        
        ActiveWorkbook.Close
    
        strFile = Dir
    
    Wend
    
    Application.ScreenUpdating = True
    
    MsgBox intCounter & " files processed.", vbInformation, "Confirmation"
        
End Sub

 

[TheWennerWoman]

Thanks both, I'll try the solutions out when I'm back in work tomorrow.

I appreciate your time in assisting.