Replace File Dialog Picker with Path

[scotsrule08]

Good day friends,

I have a macro which selects a folder and then makes a Dir list and counts the number of pages in the pdf.

I am needing to replace the folder picker portion of the code with the static path of a folder. (This would prevent me from having to select the same folder every time)

Any help is greatly appreciated.

Sub Test()
    Dim I As Long
    Dim xRg As Range
    Dim xStr As String
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Dim xFileNum As Long
    Dim RegExp As Object
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
        Set xRg = Range("A1")
        Range("A:C").ClearContents
        Range("A1:C1").Font.Bold = True
        xRg = "File Name"
        xRg.Offset(0, 1) = "Pages"
        xRg.Offset(0, 2) = "New Name"
        I = 2
        xStr = ""
        Do While xFileName <> ""
            Cells(I, 1) = xFileName
            Set RegExp = CreateObject("VBscript.RegExp")
            RegExp.Global = True
            RegExp.Pattern = "/Type\s*/Page[^s]"
            xFileNum = FreeFile
            Open (xFdItem & xFileName) For Binary As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=xFileNum]#xFileNum[/URL] 
                xStr = Space(LOF(xFileNum))
                Get [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=xFileNum]#xFileNum[/URL] , , xStr
            Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=xFileNum]#xFileNum[/URL] 
            Cells(I, 2) = RegExp.Execute(xStr).Count
            I = I + 1
            xFileName = Dir
        Loop
        Columns("A:B").AutoFit
    End If
    Call FillFormula
End Sub

 

[Norie]

Try this, replace the part in red with the path to the folder from which you want to get a list of files.

Sub Test()
Dim I As Long
Dim xRg As Range
Dim xStr As String
Dim xFd As FileDialog
Dim xFdItem As String
Dim xFileName As String
Dim xFileNum As Long
Dim RegExp As Object

    xFdItem = "C:\YourPathHere\"

    xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
    
    Set xRg = Range("A1")
    Range("A:C").ClearContents
    Range("A1:C1").Font.Bold = True
    xRg = "File Name"
    xRg.Offset(0, 1) = "Pages"
    xRg.Offset(0, 2) = "New Name"
    
    I = 2
    
    xStr = ""
    
    Do While xFileName <> ""
        Cells(I, 1) = xFileName
        Set RegExp = CreateObject("VBscript.RegExp")
        RegExp.Global = True
        RegExp.Pattern = "/Type\s*/Page[^s]"
        xFileNum = FreeFile
        Open (xFdItem & xFileName) For Binary As #xFileNum 
        xStr = Space(LOF(xFileNum))
        Get #xFileNum , , xStr
        Close #xFileNum 
        Cells(I, 2) = RegExp.Execute(xStr).Count
        I = I + 1
        xFileName = Dir
    Loop
    
    Columns("A:B").AutoFit

    Call FillFormula

End Sub

 

[scotsrule08]

You are my hero! It has been a long day and I was a potato ? to not figure that out. Thanks so much!