Dir Function not returning next file after Custom Function called

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

Code:

---

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;

Code:

---

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:

Code:

---

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

Solved on other forum (link in Original Post)

Quote:

---

Originally Posted by wideboydixon

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

Code:

---

        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:

Code:

---

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

---

to this:

Code:

---

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

---

WBD

---