Hi guys
Firstly, a big thanks to the community here. I have always seemed to get the answer to my queries so hopefully today won't be any different. I am NOT a vba coder but have managed to bluff and blag my way to get to this point.
I have made a spreadsheet where the user loads a list of file names from a folder (always word documents) and then opens each document to see if certain criterion has been met e.g. number of X's, etc (school reports) Then it reports back to the spreadsheet and says if it is complete or missing information.
It actually works they way it is but it does take a long time to report back and I was wondering if there was any way I could make it faster? Any help or work on it would be greatly appreciated.
Firstly, a big thanks to the community here. I have always seemed to get the answer to my queries so hopefully today won't be any different. I am NOT a vba coder but have managed to bluff and blag my way to get to this point.
I have made a spreadsheet where the user loads a list of file names from a folder (always word documents) and then opens each document to see if certain criterion has been met e.g. number of X's, etc (school reports) Then it reports back to the spreadsheet and says if it is complete or missing information.
It actually works they way it is but it does take a long time to report back and I was wondering if there was any way I could make it faster? Any help or work on it would be greatly appreciated.
Code:
Sub ListFiles()
' Variables for folder select
Dim objFSO As Scripting.FileSystemObject
Dim objTopFolder As Scripting.Folder
Dim strTopFolderName As String
Dim diaFolder As FileDialog
Dim Fname As String
' Variables for delete baja
Dim Rng As Range, DelCol As New Collection, x
Dim i As Long, j As Long, k As Long
Dim i2 As Integer
' Variables for opening word
Dim wApp As Word.Application
Dim wDoc As Word.Document
ThisWorkbook.Sheets("Sheet1").Cells.ClearContents
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Show
' Variables needed to set template
Dim TemplateNeeded As String
' start of code
Fname = diaFolder.SelectedItems(1)
ActiveSheet.Range("B9") = Fname
Range("A1").Value = "Student Name"
Range("B1").Value = "Group Name"
Range("C1").Value = "File Path"
Range("D1").Value = "Status"
strTopFolderName = Fname
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTopFolder = objFSO.GetFolder(strTopFolderName)
Call RecursiveFolder(objTopFolder, True)
'Change the width of the columns to achieve the best fit
Columns.AutoFit
' Delete Bajas rows
j = Cells.SpecialCells(xlCellTypeLastCell).Row 'can be: j = Range("C" & Rows.Count).End(xlUp).Row
' Collect rows range with Baja
Const Baja = "baja" ' <-- change to suit
For i = 1 To j
If WorksheetFunction.CountIf(Rows(i), Baja) > 0 Then
k = k + 1
If k = 1 Then
Set Rng = Rows(i)
Else
Set Rng = Union(Rng, Rows(i))
If k >= 100 Then
DelCol.Add Rng
k = 0
End If
End If
End If
Next
If k > 0 Then DelCol.Add Rng
' Turn off screen updating and events
Application.ScreenUpdating = False
Application.EnableEvents = False
' Delete rows with Baja
For Each x In DelCol
x.Delete
Next
' Update UsedRange
With ActiveSheet.UsedRange: End With
' Restore screen updating and events
Application.ScreenUpdating = True
Application.EnableEvents = True
' delete tempfile
For i2 = Range("c" & Rows.Count).End(xlUp).Row To 1 Step -1
If InStr(1, Cells(i2, 3), "~$") <> 0 Or InStr(1, Cells(i, 3), "left") <> 0 Or InStr(1, Cells(i, 3), "BAJA") <> 0 Then
Cells(i2, 3).EntireRow.Delete
End If
Next i2
' check reports
Sheets("sheet1").Select
FinalRow = Range("A9999").End(xlUp).Row
For i = 2 To FinalRow
Path = Sheets("sheet1").Range("B" & i).Text
' put template variable in
If InStr(Range("B" & i), "Wonder") > 0 Then Range("E" & i).Value = "EVALUATION REPORT 1st Primary"
If InStr(Range("B" & i), "CAE 1") > 0 Then Range("E" & i).Value = "EVALUATION REPORT CAE1"
If InStr(Range("B" & i), "CAE 2") > 0 Then Range("E" & i).Value = "EVALUATION REPORT CAE23"
If InStr(Range("B" & i), "CAE 3") > 0 Then Range("E" & i).Value = "EVALUATION REPORT CAE23"
If InStr(Range("B" & i), "CPE") > 0 Then Range("E" & i).Value = "EVALUATION REPORT CPE"
If InStr(Range("B" & i), "FCE 1") > 0 Then Range("E" & i).Value = "EVALUATION REPORT FCE1"
If InStr(Range("B" & i), "FCE 2") > 0 Then Range("E" & i).Value = "EVALUATION REPORT FCE2"
If InStr(Range("B" & i), "FCE 3") > 0 Then Range("E" & i).Value = "EVALUATION REPORT FCE34"
If InStr(Range("B" & i), "FCE 4") > 0 Then Range("E" & i).Value = "EVALUATION REPORT FCE34"
If InStr(Range("B" & i), "Fleas A") > 0 Then Range("E" & i).Value = "EVALUATION REPORT Infants"
If InStr(Range("B" & i), "Pockets") > 0 Then Range("E" & i).Value = "EVALUATION REPORT Infants"
If InStr(Range("B" & i), "KET") > 0 Then Range("E" & i).Value = "EVALUATION REPORT KET"
If InStr(Range("B" & i), "PET 0") > 0 Then Range("E" & i).Value = "EVALUATION REPORT KET"
If InStr(Range("B" & i), "Drivers") > 0 Then Range("E" & i).Value = "EVALUATION REPORT Movers & Flyers"
If InStr(Range("B" & i), "Flyers") > 0 Then Range("E" & i).Value = "EVALUATION REPORT Movers & Flyers"
If InStr(Range("B" & i), "Movers") > 0 Then Range("E" & i).Value = "EVALUATION REPORT Movers & Flyers"
If InStr(Range("B" & i), "Pilots") > 0 Then Range("E" & i).Value = "EVALUATION REPORT Movers & Flyers"
If InStr(Range("B" & i), "PET 1") > 0 Then Range("E" & i).Value = "EVALUATION REPORT PET B1 BLAST"
If InStr(Range("B" & i), "PET 2") > 0 Then Range("E" & i).Value = "EVALUATION REPORT PET B1 BLAST"
If InStr(Range("B" & i), "PET 3") > 0 Then Range("E" & i).Value = "EVALUATION REPORT PET3"
If InStr(Range("B" & i), "Starters") > 0 Then Range("E" & i).Value = "EVALUATION REPORT Starters"
Next i
' open word document
Sheets("sheet1").Select
FinalRow = Range("A9999").End(xlUp).Row
For i = 2 To FinalRow
Path = Sheets("sheet1").Range("C" & i).Text
TemplateNeeded = Range("E" & i).Value
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(Path)
'objWord.Visible = True
' EVALUATION REPORT 1st Primary
If TemplateNeeded = "EVALUATION REPORT 1st Primary" Then
With objWord.ActiveDocument.Content.Find
Do While .Execute(FindText:="X", Forward:=True, Format:=True, MatchWholeWord:=True) = True
y = y + 1
Loop
End With
TickCount = Str$(y)
ReqCount = 9
If ReqCount - TickCount = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DLectivosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DAsistidosT1")
If docCCs.Count = 0 Then
Range("D" & i).Value = "Complete"
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit
y = 0
End If
' EVALUATION REPORT CAE1
If TemplateNeeded = "EVALUATION REPORT CAE1" Then
With objWord.ActiveDocument.Content.Find
Do While .Execute(FindText:="X", Forward:=True, Format:=True, MatchWholeWord:=True) = True
y = y + 1
Loop
End With
TickCount = Str$(y)
'ticks for CAE1 are 13
ReqCount = 13
If ReqCount - TickCount = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DLectivosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DAsistidosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaTareaT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaExamenT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaExamenT1a")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("Tarde1")
If docCCs.Count = 0 Then
Range("D" & i).Value = "Complete"
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit
y = 0
End If
' EVALUATION REPORT CAE23
If TemplateNeeded = "EVALUATION REPORT CAE23" Then
With objWord.ActiveDocument.Content.Find
Do While .Execute(FindText:="X", Forward:=True, Format:=True, MatchWholeWord:=True) = True
y = y + 1
Loop
End With
TickCount = Str$(y)
'ticks for CAE23 are 13
ReqCount = 13
If ReqCount - TickCount = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DLectivosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DAsistidosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaTareaT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaExamenT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("Tarde1")
If docCCs.Count = 0 Then
Range("D" & i).Value = "Complete"
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit
y = 0
End If
'EVALUATION REPORT CPE
If TemplateNeeded = "EVALUATION REPORT CPE" Then
With objWord.ActiveDocument.Content.Find
Do While .Execute(FindText:="X", Forward:=True, Format:=True, MatchWholeWord:=True) = True
y = y + 1
Loop
End With
TickCount = Str$(y)
'ticks for CPE are 13
ReqCount = 13
If ReqCount - TickCount = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DLectivosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DAsistidosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaTareaT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaExamenT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("Tarde1")
If docCCs.Count = 0 Then
Range("D" & i).Value = "Complete"
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit
y = 0
End If
'EVALUATION REPORT FCE1
If TemplateNeeded = "EVALUATION REPORT FCE1" Then
With objWord.ActiveDocument.Content.Find
Do While .Execute(FindText:="X", Forward:=True, Format:=True, MatchWholeWord:=True) = True
y = y + 1
Loop
End With
TickCount = Str$(y)
'ticks for FCE1 are 15
ReqCount = 15
If ReqCount - TickCount = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DLectivosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DAsistidosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaTareaT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaExamenT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("Tarde1")
If docCCs.Count = 0 Then
Range("D" & i).Value = "Complete"
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit
y = 0
End If
'EVALUATION REPORT FCE2
If TemplateNeeded = "EVALUATION REPORT FCE2" Then
With objWord.ActiveDocument.Content.Find
Do While .Execute(FindText:="X", Forward:=True, Format:=True, MatchWholeWord:=True) = True
y = y + 1
Loop
End With
TickCount = Str$(y)
'ticks for FCE2 are 15
ReqCount = 15
If ReqCount - TickCount = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DLectivosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DAsistidosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaTareaT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaExamenT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("Tarde1")
If docCCs.Count = 0 Then
Range("D" & i).Value = "Complete"
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit
y = 0
End If
'EVALUATION REPORT FCE34
If TemplateNeeded = "EVALUATION REPORT FCE34" Then
With objWord.ActiveDocument.Content.Find
Do While .Execute(FindText:="X", Forward:=True, Format:=True, MatchWholeWord:=True) = True
y = y + 1
Loop
End With
TickCount = Str$(y)
'ticks for FCE34 are 13
ReqCount = 13
If ReqCount - TickCount = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DLectivosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DAsistidosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaTareaT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaExamenT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("Tarde1")
If docCCs.Count = 0 Then
Range("D" & i).Value = "Complete"
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit
y = 0
End If
' EVALUATION REPORT Infants
If TemplateNeeded = "EVALUATION REPORT Infants" Then
With objWord.ActiveDocument.Content.Find
Do While .Execute(FindText:="X", Forward:=True, Format:=True, MatchWholeWord:=True) = True
y = y + 1
Loop
End With
TickCount = Str$(y)
' ticks for Infants are 8
ReqCount = 8
If ReqCount - TickCount = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DLectivosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DAsistidosT1")
If docCCs.Count = 0 Then
Range("D" & i).Value = "Complete"
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit
y = 0
End If
' EVALUATION REPORT KET
If TemplateNeeded = "EVALUATION REPORT KET" Then
With objWord.ActiveDocument.Content.Find
Do While .Execute(FindText:="X", Forward:=True, Format:=True, MatchWholeWord:=True) = True
y = y + 1
Loop
End With
TickCount = Str$(y)
'ticks for EVALUATION REPORT KET are 12
ReqCount = 12
If ReqCount - TickCount = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DLectivosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DAsistidosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaExamenT1")
If docCCs.Count = 0 Then
Range("D" & i).Value = "Complete"
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit
y = 0
End If
' EVALUATION REPORT Movers & Flyers
If TemplateNeeded = "EVALUATION REPORT Movers & Flyers" Then
With objWord.ActiveDocument.Content.Find
Do While .Execute(FindText:="X", Forward:=True, Format:=True, MatchWholeWord:=True) = True
y = y + 1
Loop
End With
TickCount = Str$(y)
'ticks for EVALUATION REPORT Movers & Flyers are 13
ReqCount = 13
If ReqCount - TickCount = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DLectivosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DAsistidosT1")
If docCCs.Count = 0 Then
Range("D" & i).Value = "Complete"
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit
y = 0
End If
' EVALUATION REPORT PET B1 BLAST
If TemplateNeeded = "EVALUATION REPORT PET B1 BLAST" Then
With objWord.ActiveDocument.Content.Find
Do While .Execute(FindText:="X", Forward:=True, Format:=True, MatchWholeWord:=True) = True
y = y + 1
Loop
End With
TickCount = Str$(y)
'ticks for EVALUATION REPORT PET B1 BLAST are 14
ReqCount = 14
If ReqCount - TickCount = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DLectivosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DAsistidosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaTareaT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaExamenT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaProyectoT1")
If docCCs.Count = 0 Then
Range("D" & i).Value = "Complete"
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit
y = 0
End If
'EVALUATION REPORT PET3
If TemplateNeeded = "EVALUATION REPORT PET3" Then
With objWord.ActiveDocument.Content.Find
Do While .Execute(FindText:="X", Forward:=True, Format:=True, MatchWholeWord:=True) = True
y = y + 1
Loop
End With
TickCount = Str$(y)
'ticks for EVALUATION REPORT PET3 are 13
ReqCount = 13
If ReqCount - TickCount = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DLectivosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DAsistidosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaTareaT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("NotaExamenT1")
If docCCs.Count = 0 Then
Range("D" & i).Value = "Complete"
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit
y = 0
End If
'EVALUATION REPORT Starters
If TemplateNeeded = "EVALUATION REPORT Starters" Then
With objWord.ActiveDocument.Content.Find
Do While .Execute(FindText:="X", Forward:=True, Format:=True, MatchWholeWord:=True) = True
y = y + 1
Loop
End With
TickCount = Str$(y)
'ticks for EVALUATION REPORT Starters are 10
ReqCount = 10
If ReqCount - TickCount = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DLectivosT1")
If docCCs.Count = 0 Then
Set docCCs = objWord.ActiveDocument.SelectContentControlsByTag("DAsistidosT1")
If docCCs.Count = 0 Then
Range("D" & i).Value = "Complete"
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
Else
Range("D" & i).Value = "Missing Information"
End If
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit
y = 0
End If
Next i
End Sub
Sub RecursiveFolder(objFolder As Scripting.Folder, _
IncludeSubFolders As Boolean)
'Declare the variables
Dim objFile As Scripting.File
Dim objSubFolder As Scripting.Folder
Dim NextRow As Long
'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
Cells(NextRow, "A").Value = objFile.Name
Cells(NextRow, "B").Value = objFolder.Name
Cells(NextRow, "C").Value = objFile.Path
NextRow = NextRow + 1
Next objFile
'Loop through files in the subfolders
If IncludeSubFolders Then
For Each objSubFolder In objFolder.SubFolders
Call RecursiveFolder(objSubFolder, True)
Next objSubFolder
End If
End Sub
