Hello,
Having to move some files that were written by somebody else many years ago from Excel 2003 to 2010, files contain FileSearch that no longer works in 2010.
Searched and found https://www.mrexcel.com/forum/excel...tions-replacement-application-filesearch.html which includes code from Mohammad Basem, however with my limited knowledge I am unable to modify the code accordingly. Can anybody help?
Having to move some files that were written by somebody else many years ago from Excel 2003 to 2010, files contain FileSearch that no longer works in 2010.
Searched and found https://www.mrexcel.com/forum/excel...tions-replacement-application-filesearch.html which includes code from Mohammad Basem, however with my limited knowledge I am unable to modify the code accordingly. Can anybody help?
Code:
Sub fileCheckForNewFiles()
fileCheckNewCancelTime
DirName = Workbooks(ThisWorkbook.Name).Worksheets("Setup").[DirName]
ArchiveDirName = Workbooks(ThisWorkbook.Name).Worksheets("Setup").[ArchiveDirectory]
With Application.FileSearch
.LookIn = DirName
.SearchSubFolders = False
.Filename = "*.csv"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
If Workbooks(ThisWorkbook.Name).Worksheets("Setup").[FileInDir] = True Then
For n = 1 To .FoundFiles.Count
DirName = Workbooks(ThisWorkbook.Name).Worksheets("Setup").[DirName]
SelectedFileName = .FoundFiles(n)
SelectedFileName = Right(SelectedFileName, Len(SelectedFileName) - Len(DirName) - 1)
If SelectedFileName Like "*.Defects.csv" Then
FolioNumber = Left(SelectedFileName, Len(SelectedFileName) - 12)
ElseIf SelectedFileName Like "*.Class Summary.csv" Then
FolioNumber = Left(SelectedFileName, Len(SelectedFileName) - 18)
ElseIf SelectedFileName Like "*.Inspection Setup.csv" Then
FolioNumber = Left(SelectedFileName, Len(SelectedFileName) - 21)
End If
For i = Len(FolioNumber) To 1 Step -1
If Mid(FolioNumber, i, 1) = "." Then
FolioNumber = Right(FolioNumber, Len(FolioNumber) - i)
Exit For
End If
Next i
If Application.WorksheetFunction.CountIf(Workbooks(ThisWorkbook.Name).Sheets("Data").Columns(4), FolioNumber) = 0 Then
FoundData = False
Application.ScreenUpdating = False
dataChangeProtectionState False, "cogmin"
Workbooks(ThisWorkbook.Name).Worksheets("Setup").[CurrentFile] = DirName & "\" & SelectedFileName
dataAnalyseNewFolio FolioNumber
Workbooks(ThisWorkbook.Name).Worksheets("Setup").[CurrentFile] = DirName & "\" & SelectedFileName
cmdBarUpdateMIDS
CommandBars("Defect Rate Calculator").Controls("Jump to MID Number").ListIndex = Application.WorksheetFunction.CountA(Workbooks(ThisWorkbook.Name).Worksheets("Data").Columns(1)) - 1
'Turn sheet protection On
If Not Workbooks(ThisWorkbook.Name).Worksheets("setup").[DevModeOn] Then
dataChangeProtectionState True, "cogmin"
End If
Exit For
Else
FoundData = True
End If
Next n
If Not FolioNumber = "" Then
fileTransferToArchive
End If
End If
End If
End With
On Error Resume Next
ShowPics = False
If ShowPics Then
ActiveSheet.Shapes("MIDWarning").Visible = False
ActiveSheet.Shapes("FailurePic").Visible = True
[ReverseLaneMap] = "Reverse Lane Map"
fileCheckNewSetTime
Else
fileCheckNewSetTime
End If
Workbooks(ThisWorkbook.Name).Worksheets("Defect Rate").Activate
'Turn sheet protection On
If Not Workbooks(ThisWorkbook.Name).Worksheets("setup").[DevModeOn] Then
dataChangeProtectionState True, "cogmin"
End If
'If Round(Rnd() * 10, 0) = 5 Then
Workbooks(ThisWorkbook.Name).Save
'End If
End Sub