I am trying to loop all the files in a folder, while trying to loop it is not looping instead it is selecting the same file and if I tried with wild card Dir becomes null character. I need to check all the excel files and if folder exist, I need to check the folder also. If I add wild card, code does not run or the loop is picking up the same file.
Sub Check()
Dim OpenFolder As String
Dim Openfile As String
Dim Res As Workbook
Set Res = Workbooks("Macro for file opener")
Dim Ressh As Worksheet
Set Ressh = Res.Sheets("Result")
Dim WS As Worksheet
Dim WC As Worksheet
Dim DC As Boolean
Dim MP As Boolean
Dim NB As Boolean
OpenFolder = Application.GetOpenFilename()
Openfile = Dir(OpenFolder)
Do While Openfile <> ""
Workbooks.Open (OpenFolder)
Set WS = Sheets("Type A")
'File present
If WS.Name = "Type A" Then
WS.Select
On Error Resume Next
DC = Cells.Find(What:="code", After:=ActiveCell, LookIn:=xlFormulas2, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
If DC = True Then
Res.Activate
Ressh.Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Openfile
ActiveCell.Offset(0, 1).Value = "code exist"
Else
Res.Activate
Ressh.Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Openfile
ActiveCell.Offset(0, 1).Value = "code not exist"
End If
'Missing part
Workbooks.Open (OpenFolder)
On Error Resume Next
WS.Select
MP = Cells.Find(What:="Missing part", After:=ActiveCell, LookIn:=xlFormulas2, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
If MP = True Then
Res.Activate
Ressh.Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 2).Value = "Missing part exist"
Else
Res.Activate
Ressh.Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, 2).Value = "Missing part not exist"
End If
'File not present
Else
Res.Activate
Ressh.Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Openfile
ActiveCell.Offset(0, 1).Value = "file not exist"
End If
Workbooks.Open (OpenFolder)
Set WC = Sheets("Chart")
'File name exist
If WC.Name = "Chart" Then
On Error Resume Next
WC.Select
NB = Cells.Find(What:="Non-Buildable Usage", After:=ActiveCell, LookIn:=xlFormulas2, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
If NB = True Then
Res.Activate
Ressh.Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 3).Value = "Non break exist"
Else
Res.Activate
Ressh.Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 3).Value = "Non break not exist"
End If
'File not exist
Else
Res.Activate
Ressh.Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, 3).Value = "file not exist"
End If
DoEvents
Openfile = Dir()
Loop
End Sub