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.excelfox.com/forum/showt...ng-next-file-after-Custom-Function-called#top

 

[wideboydixon]

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

 

[friel300]

This is perfect WBD, thank you.

Its simple when you put it like that.

Thanks again.