AnsweredAssumed Answered

Macro Loop Issue on finding documents

Question asked by Joe Pickens on Feb 16, 2016
Latest reply on Feb 16, 2016 by 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

Outcomes