Results 1 to 2 of 2

Thread: Dir Function not returning next file after Custom Function called

  1. #1
    Junior Member
    Join Date
    Sep 2012
    Posts
    8
    Rep Power
    0

    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
    Last edited by Friel300; 07-29-2016 at 11:49 AM. Reason: Added Cross Post [SOLVED]

  2. #2
    Junior Member
    Join Date
    Sep 2012
    Posts
    8
    Rep Power
    0
    Solved on other forum (link in Original Post)

    Quote Originally Posted by wideboydixon View Post
    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

Similar Threads

  1. List Files In Folder & Subfolders Using DIR
    By VijaySM in forum Excel Help
    Replies: 3
    Last Post: 12-08-2015, 11:25 AM
  2. UDF (user defined function) replacement for Excel's DATEDIF function
    By Rick Rothstein in forum Rick Rothstein's Corner
    Replies: 21
    Last Post: 03-07-2015, 09:47 PM
  3. How To Make A Custom VBA Function Available In All Workbooks
    By Safal Shrestha in forum Excel Help
    Replies: 2
    Last Post: 04-11-2013, 02:01 PM
  4. Rank Function
    By Portucale in forum Access Help
    Replies: 2
    Last Post: 01-23-2013, 11:26 PM
  5. Val Function
    By Transformer in forum Familiar with Commands and Formulas
    Replies: 10
    Last Post: 09-14-2012, 04:12 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •