1 Reply Latest reply on Feb 16, 2016 3:27 PM by Joe Pickens

    Macro Loop Issue on finding documents

    Joe Pickens

      When i run my Module by its self it works perfectly but when i call it out and run it in a loop it works intermittently. Can anyone tell me whats wrong with it.

      My Module 2 Sub Search_Excel_For_Comp() Looks at my excel sheet and pulls out the level one components and runs the part number in a file search in module 7

       

      Module 7 does a folder loop that searches a file name in a given directory. and returns me the most recently modified document and its File path along with some document properties

       

       

      here is the code for my module 2

       

      Sub Search_Excel_For_Comp()

      Dim row             As Integer

      Dim Str             As String

      Dim Count           As Integer

      Dim SWPrtLC         As String

      Dim SFolder         As String

      Dim SearchSte       As String

      Dim Fname           As String

      Dim Value           As String

       

      SFolder = "C:\Temp\"

      Value = Dir(SFolder)

       

      'Search till there is a blank value in column A

              While Sheets("JDE BOM").Range("A6").Offset(Count, 0).Value <> ""

          'While Cells(Count + 6, "A").Value <> ""

      'Only search values that have the number 1 in column E

              If Sheets("JDE BOM").Range("E6").Offset(Count, 0).Value = 1 Then

             

                  Fname = Sheets("JDE BOM").Range("A6").Offset(Count, 0).Value

             

                  Call Module7.ListFiles(Fname)

                  Sheets("JDE BOM").Range("R6").Offset(Count, 0).Value = Fname

                 

              End If

         

          Count = Count + 1

          Wend

      End Sub

       

       

      And this is the code i am using in my module 7

       

      Dim LatestDate      As Date

      Dim FileDate        As Date

      Dim Fname           As String

      Dim FPath           As String

      Dim FSize           As Long

      Dim FType           As String

      Dim FDate           As String

      Dim NextRow         As Long

      'Dim CompName        As String

      Dim Count           As Integer

      'Force the explicit delcaration of variables

      Option Explicit

       

       

      Sub ListFiles(CompName As String)

      'Sub ListFiles()

          'CompName = "093116010"

          'Set a reference to Microsoft Scripting Runtime by using

          'Tools > References in the Visual Basic Editor (Alt+F11)

        

          'Declare the variables

          Dim objFSO              As Scripting.FileSystemObject

          Dim objTopFolder        As Scripting.folder

          Dim strTopFolderName    As String

          'Dim WS                  As Worksheet

         

         

      Fname = CompName

      FPath = 0

      FSize = 0

      FType = 0

      FDate = 0

         

         

          ActiveWorkbook.Sheets("Sheet1").Activate

        

          'Insert the headers for Columns A through F

          Sheets("Sheet1").Range("A1").Value = "File Name"

          Sheets("Sheet1").Range("B1").Value = "File Size"

          Sheets("Sheet1").Range("C1").Value = "File Type"

          Sheets("Sheet1").Range("D1").Value = "Date Created"

          Sheets("Sheet1").Range("E1").Value = "Date Last Accessed"

          Sheets("Sheet1").Range("F1").Value = "Date Last Modified"

        

          'Assign the top folder to a variable

          strTopFolderName = "C:\Temp"

        

          'Create an instance of the FileSystemObject

          Set objFSO = CreateObject("Scripting.FileSystemObject")

        

          'Get the top folder

          Set objTopFolder = objFSO.GetFolder(strTopFolderName)

        

          'Call the RecursiveFolder routine

          Call RecursiveFolder(objTopFolder, True, Fname)

        

        

          NextRow = Cells(Rows.Count, "A").End(xlUp).row + 1

       

       

                      Cells(NextRow, "A").Value = Fname

                      Cells(NextRow, "B").Value = FSize

                      Cells(NextRow, "C").Value = FType

                      Cells(NextRow, "F").Value = FDate

                      Cells(NextRow, "E").Value = FPath

                      Sheets("JDE BOM").Range("S6").Offset(Count, 0).Value = Fname

                      NextRow = NextRow + 1

                      Count = Count + 1

       

        

          'Change the width of the columns to achieve the best fit

          Columns.AutoFit

        

      End Sub

       

      Sub RecursiveFolder(objFolder As Scripting.folder, includeSubfolders As Boolean, CompName As String)

       

          'Declare the variables

          Dim objFile         As Scripting.file

          Dim objSubFolder    As Scripting.folder

          Dim Fname           As String

         

          Fname = CompName

          

          'Find the next available row

          NextRow = Cells(Rows.Count, "A").End(xlUp).row + 1

        

          'Loop through each file in the folder

          For Each objFile In objFolder.Files

              If Mid(objFile.Name, 1, Len(objFile.Name) - 7) = CompName Then

                  If Right(objFile.Name, 6) = "sldprt" Or Right(objFile.Name, 6) = "sldasm" Or Right(objFile.Name, 6) = "SLDPRT" Or Right(objFile.Name, 6) = "SLDASM" Then

                     

                      LatestDate = objFile.DateLastModified

                      If LatestDate > FileDate Then

                      FileDate = LatestDate

                               

                      Fname = Mid(objFile.Name, 1, Len(objFile.Name) - 7)

                      FSize = objFile.Size

                      FType = objFile.Type

                      FDate = objFile.DateLastModified

                      FPath = objFile.Path

                               

                      End If

                  End If

            End If

            

          Next objFile

        

          'Loop through files in the subfolders

          If includeSubfolders Then

              For Each objSubFolder In objFolder.Subfolders

                  Call RecursiveFolder(objSubFolder, True, CompName)

              Next objSubFolder

          End If

                                      

      End Sub

        • Re: Macro Loop Issue on finding documents
          Joe Pickens

          I Figured it out i needed to reset my date variable

          here this is my updated module 7

          Dim LatestDate      As Date

          Dim FileDate        As Date

          Dim FName           As String

          Dim FPath           As String

          Dim FSize           As Long

          Dim FType           As String

          Dim FDate           As String

          Dim NextRow         As Long

          'Dim CompName        As String

          Dim Count           As Integer

          'Force the explicit delcaration of variables

          Option Explicit

           

           

          Sub ListFiles(CompName As String)

          'Sub ListFiles()

              'CompName = "093116010"

              'Set a reference to Microsoft Scripting Runtime by using

              'Tools > References in the Visual Basic Editor (Alt+F11)

            

              'Declare the variables

              Dim objFSO              As Scripting.FileSystemObject

              Dim objTopFolder        As Scripting.folder

              Dim strTopFolderName    As String

              'Dim WS                  As Worksheet

             

             

          FName = CompName

          FPath = 0

          FSize = 0

          FType = 0

          FDate = 0

          LatestDate = 0

          FileDate = 0

          NextRow = 0

          Count = 0

           

           

              ActiveWorkbook.Sheets("Sheet1").Activate

            

              'Insert the headers for Columns A through F

              Sheets("Sheet1").Range("A1").Value = "File Name"

              Sheets("Sheet1").Range("B1").Value = "File Size"

              Sheets("Sheet1").Range("C1").Value = "File Type"

              Sheets("Sheet1").Range("D1").Value = "Date Created"

              Sheets("Sheet1").Range("E1").Value = "Date Last Accessed"

              Sheets("Sheet1").Range("F1").Value = "Date Last Modified"

            

              'Assign the top folder to a variable

              strTopFolderName = "C:\Temp"

            

              'Create an instance of the FileSystemObject

              Set objFSO = CreateObject("Scripting.FileSystemObject")

            

              'Get the top folder

              Set objTopFolder = objFSO.GetFolder(strTopFolderName)

            

              'Call the RecursiveFolder routine

              Call RecursiveFolder(objTopFolder, True, FName)

            

            

              NextRow = Cells(Rows.Count, "A").End(xlUp).row + 1

           

           

                          Cells(NextRow, "A").Value = FName

                          Cells(NextRow, "B").Value = FSize

                          Cells(NextRow, "C").Value = FType

                          Cells(NextRow, "F").Value = FDate

                          Cells(NextRow, "E").Value = FPath

                          Sheets("JDE BOM").Range("S6").Offset(Count, 0).Value = FName

                          NextRow = NextRow + 1

                          Count = Count + 1

                         

          '                Sheets("Sheet1").Range("A").Offset(NextRow, 0).Value = FName

          '                Sheets("Sheet1").Range("B").Offset(NextRow, 0).Value = FSize

          '                Sheets("Sheet1").Range("C").Offset(NextRow, 0).Value = FType

          '                Sheets("Sheet1").Range("E").Offset(NextRow, 0).Value = FDate

          '                Sheets("Sheet1").Range("F").Offset(NextRow, 0).Value = FPath

          '

            

            

              'Change the width of the columns to achieve the best fit

              Columns.AutoFit

            

          End Sub

           

           

          Sub RecursiveFolder(objFolder As Scripting.folder, includeSubfolders As Boolean, CompName As String)

           

           

              'Declare the variables

              Dim objFile         As Scripting.file

              Dim objSubFolder    As Scripting.folder

              Dim FName           As String

             

              FName = CompName

           

           

            

              'Find the next available row

              NextRow = Cells(Rows.Count, "A").End(xlUp).row + 1

            

              'Loop through each file in the folder

              For Each objFile In objFolder.Files

                  If Mid(objFile.Name, 1, Len(objFile.Name) - 7) = CompName Then

                      If Right(objFile.Name, 6) = "sldprt" Or Right(objFile.Name, 6) = "sldasm" Or Right(objFile.Name, 6) = "SLDPRT" Or Right(objFile.Name, 6) = "SLDASM" Then

                         

                          LatestDate = objFile.DateLastModified

                          If LatestDate > FileDate Then

                          FileDate = LatestDate

                                   

                          FName = Mid(objFile.Name, 1, Len(objFile.Name) - 7)

                          FSize = objFile.Size

                          FType = objFile.Type

                          FDate = objFile.DateLastModified

                          FPath = objFile.Path

                                   

                          End If

                      End If

                End If

                

              Next objFile

            

              'Loop through files in the subfolders

              If includeSubfolders Then

                  For Each objSubFolder In objFolder.Subfolders

                      Call RecursiveFolder(objSubFolder, True, CompName)

                  Next objSubFolder

              End If

            

                

                

                

            

            

            

          End Sub