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-q...ml#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