Dir Function not returning next file after Custom Function called

[Friel300]

Hi All,

I'm having trouble with a macro I have been writing.

The intent is to run through all files in a specified directory, open each one and copy a predetermined sheet into my workbook.

I am using
sFile = Dir(sFile & "*") to loop through my files.
I am using another sub (ImportSheet) with 2 arguments (File Path & File name, sheet name) to copy the sheets to my workbook.
Whenever I come out of this secondary "ImportSheet" sub the Dir function doesn't return the next file in the directory; it instead returns "".


This is the code I have been using;

Sub Import_PFMEA_Sheets()
Dim sFile, sFilePath, sOP 'As String

sFile = SETTINGS.Range("B1").Value
sFilePath = SETTINGS.Range("B1").Value


If FOLDER(sFile) = True Then 'test to see if file exists
sFile = Dir(sFile & "*")

Do While Len(sFile) > 0
sOP = Left(Replace(sFile, "PFMEA - ", ""), 8)
For x = 5 To Sheets.Count
If ThisWorkbook.Sheets(x).Name = sOP Then
MsgBox "ERR" 'sheet already exists
GoTo Nxt1
End If

Next
Call ImportSheet(sFilePath & sFile, sOP)






Nxt1:
' Debug.Print sFile
sFile = Dir
Loop

Else: GoTo Error2
End If


Exit Sub
Error2:

End Sub


ImportSheet function:



Sub ImportSheet(sImportFile, sSheetName) 'as String
Dim sImpFile As String
Dim sThisBk As Workbook
Dim vfilename As Variant
Dim wsSht As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sThisBk = ActiveWorkbook

' sImportFile = "D:\desktop shortcuts\HELP\Dave Glover\PFMEA Master Document\OLD Style JB naming\PFMEA - 1007_001-9-15 v1.xlsm" 'Path of workbook

If sImportFile = "False" Then 'Check Path is correct
MsgBox "No File Selected!"
Exit Sub

Else
sImpFile = Dir(sImportFile)
Application.Workbooks.Open Filename:=sImportFile, UpdateLinks:=False

Set wbBk = Workbooks(sImpFile)
With wbBk
If Evaluate("ISREF('" & sSheetName & "'!A1)") Then 'sheet name
Set wsSht = .Sheets(sSheetName)
wsSht.Copy before:=sThisBk.Sheets(sThisBk.Sheets.Count)
Else
MsgBox "There is no sheet with name :" & sSheetName & " in:" & vbCr & .Name
End If
wbBk.Close SaveChanges:=False
End With
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


If the sheet already exists it returns the error message until it finds a sheet that isn't already there, copies it, then the Dir function doesn't return the next one until I rerun the code.

Cross posted here: http://www.mrexcel.com/forum/excel-questions/955672-dir-function-not-returning-next-file-after-custom-function-called.html#post4589853

[Friel300]

Solved on other forum (link in Original Post)


The second function also has a Dir() in it:



sImpFile = Dir(sImportFile)


This will "reset" the progress of the Dir() in the calling Sub and that's why it doesn't find the next file. Change this:



sImpFile = Dir(sImportFile)
Application.Workbooks.Open Filename:=sImportFile, UpdateLinks:=False

Set wbBk = Workbooks(sImpFile)


to this:



Set wbBk = Application.Workbooks.Open(Filename:=sImportFile, UpdateLinks:=False)


WBD