Working down a list

[p0is0n0us]

Hi,

I currently have a program where I can type a SSN in cell J1 and the program will go to a directory based on the SSN and do a page count of any PDF files that have the name APS in the title. I woud like to expand on this now and be able to put a list of SSN's in column J and have the program work its way down the list counting pages. I figure i need some kind of DO/LOOP command but I cant work it out. This is the code that I currently have:

Sub PageCount()
Dim MyPath As String, MyFile As String
Dim i As Long
MyPath = "I:\Images\" & Left(ActiveSheet.Range("J1").Value, 1) & "\" & ActiveSheet.Range("J1").Value
MyFile = Dir(MyPath & Application.PathSeparator & "*APS*.pdf", vbDirectory)
Range("A:B").ClearContents
Range("A1") = "File Name": Range("B1") = "Pages"
Range("A1:B1").Font.Bold = True
i = 1
Do While MyFile <> ""
i = i + 1
Cells(i, 1) = MyFile
Cells(i, 2) = GetPageNum(MyPath & Application.PathSeparator & MyFile)
MyFile = Dir
Loop
Columns("A:B").AutoFit
MsgBox "Total of " & i - 1 & " PDF files have been found" & vbCrLf _
& " File names and corresponding count of pages have been written on " _
& ActiveSheet.Name, vbInformation, "Report..."
End Sub
'
Function GetPageNum(PDF_File As String)
Dim FileNum As Long
Dim strRetVal As String
Dim RegExp
Set RegExp = CreateObject("VBscript.RegExp")
RegExp.Global = True
RegExp.Pattern = "/Type\s*/Page[^s]"
FileNum = FreeFile
Open PDF_File For Binary As #FileNum
strRetVal = Space(LOF(FileNum))
Get #FileNum, , strRetVal
Close #FileNum
GetPageNum = RegExp.Execute(strRetVal).Count
End Function

Any help you could give me would be greatly appreciated.

Gaz

 

[JLGWhiz]

You're welcome,
Regards, JLG