Listing excel files in a folder

[Bagsy]

Can anybody help a bit I please, I am putting together some code to list the excel files in a folder in column B, open each one in turn copy a value from cell D142 and paste in column C next to the file name.
What this should achieve is the a filename in column B and the description next to it in column C
I’m sure there are lots of issues with this code but at the moment I cannot get it to open the file so I can copy the data
All help is much appreciated.

Dim i As Long
Dim WB As Workbook
Dim CurrentSheet As Worksheet

Sub GetDescription()

Set ActWork = ActiveWorkbook

Worksheets("Sheet1").Select

myDir = "W:\Sub-Contract\Test\Cost Sheets"
myFile = Dir(myDir & Application.PathSeparator, vbDirectory)

Range("B3:B500").ClearContents
    Do While myFile <> ""
            i = i + 1
                Cells(i, 2).Offset(2, 0) = myFile
                    myFile = Dir
                Workbooks.Open Filename:=myDir
            Sheets("Cost Sheet").Select
        Range("D142").Copy
    wkbk.Activate 'Select Orginal Workbook
myFile.Offset(0, 1).Paste 'Paste description onto cost sheets list next to the file name
Loop

For i = 1 To Range("B65536").End(xlUp).Row

Next

End Sub

I have managed some code to work just listing the file names but cannot move to the next step and open each one as it is listed. I did originally think of listing the files first then going back and opening each one in turn from the list.

Dim i As Long
Sub List_CostSheets()

' this is listing the cost sheets only
Set ActWork = ActiveWorkbook

Worksheets("Sheet1").Select

'myDir = "W:\1works managers files\Cost sheets"
myDir = "W:\Sub-Contract\Test\Cost Sheets"

myFile = Dir(myDir & Application.PathSeparator & "*.xlsx", vbDirectory)
'Clear Data in Column B
    Range("B3:B500").ClearContents
            Do While myFile <> ""
            i = i + 1
        Cells(i, 2).Offset(2, 0) = myFile
    myFile = Dir
Loop

For i = 1 To Range("B65536").End(xlUp).Row

Next

End Sub

 

[Fluff]

Try

Sub List_CostSheets()
   Dim i As Long
   Dim Ws As Worksheet
   Dim Wbk As Workbook
   
   Set Ws = Worksheets("Sheet1")
   
   'myDir = "W:\1works managers files\Cost sheets"
   mydir = "W:\Sub-Contract\Test\Cost Sheets"
   
   myfile = Dir(mydir & Application.PathSeparator & "*.xlsx", vbDirectory)
   'Clear Data in Column B
   Ws.Range("B3:B500").ClearContents
   i = 3
   Do While myfile <> ""
      Ws.Cells(i, 2) = myfile
      Set Wbk = Workbooks.Open(mydir & "\" & myfile)
      Ws.Cells(i, 3).Value = Wbk.Sheets("Cost Sheet").Range("D142").Value
      Wbk.Close False
      myfile = Dir
      i = i + 1
   Loop
End Sub

 

[Bagsy]

Thanks Fluff that works great
Some of the excel files have links and I get a message "do I wish to update links"
How can I open the files as read only and not update links

 

[Fluff]

Try

Set Wbk = Workbooks.Open(mydir & "\" & myfile,False)

 

[Bagsy]

Brilliant thanks for your help Fluff

 

[Fluff]

You're welcome & thanks for the feedback