PDA

View Full Version : [SOLVED] Loop through folder only opens one file



lks55
04-01-2016, 07:50 AM
Hi,

i wrote this code to loop threw the whole folder, but it only opens one and the same exelsheet in the folder and it doesnt switches to the next one. what am I doing wring?


Sub AddNew()

Dim s As Variant
Dim s5 As Long
Dim lastcell As Long
Dim MyFile As String
Dim directory As String



MsgBox "Please open a file to show the path of the regions"
s = Application.GetOpenFilename("Excel Workbook (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm")
s = Left(s, InStrRev(s, "\"))
MyFile = Dir(s & "*.xl??")
Debug.Print s

Workbooks.Add
's = Application.GetSaveAsFilename("WK00 - UK Total", "Excel Files (*.xlsm), *.xlsm")
'ActiveWorkbook.SaveAs Filename:=s

Do While MyFile <> ""
Workbooks.Open (MyFile)

s5 = 4

Do While Cells(s5, 2) <> ""
s5 = s5 + 1
Loop

Range(Cells(3, 2), Cells(s5, 13)).Copy
ActiveWorkbook.Close

If Cells(1, 1) <> "" Then
ActiveCell.End(xlDown).Select
lastcell = ActiveCell.Row
Cells(lastcell + 1, 1).Select
End If

ActiveSheet.Paste
Loop


End Sub

Best Regards

Paul_Hossler
04-01-2016, 08:01 AM
https://msdn.microsoft.com/en-us/library/office/gg278779(v=office.15).aspx


QUOTE]
You must specify pathname the first time you call the Dir function, or an error occurs. If you also specify file attributes, pathname must be included.
Dir returns the first file name that matches pathname. To get any additional file names that match pathname, call Dir again with no arguments. When no more file names match, Dir returns a zero-length string (""). Once a zero-length string is returned, you must specify pathname in subsequent calls or an error occurs. You can change to a new pathname without retrieving all of the file names that match the current pathname. However, you can't call the Dir function recursively. Calling Dir with the vbDirectory attribute does not continually return subdirectories.
[/QUOTE]

Inside the loop, you need to call Dir("") to get the next one


Here's an example

https://support.microsoft.com/en-us/kb/139724

lks55
04-01-2016, 08:17 AM
wow thank you that worked well. I didnt knew it