In the range I select only prints the first PDF of the seleted rows

I select an excel range, and try to print the PDF Documents
E.g
26/06/2008      RUN Property (NSW)      000000002730981      Body Corporate Cleaning ServiceTony And Marie Moubarak      Inv 83      89.31      98.24 I:\Docs\CY1000001RPMPROD\Documents\2008\06\25 000000001057034_20080625_121119_cleaning_invoice.pdf

26/06/2008      RUN Property (NSW)      000000002730981      Body Corporate Cleaning Service Firmack Pty Ltd      Inv 83      87.26      95.99      I:\Docs\CY1000001\RPMPROD\Documents\2008\06\25\000000001057042_20080625_121939_cleaning_invoice.pdf

My Problem is it only prints the pdf in the first row, it doesnt print the pdf document from  the second row onwards.

Sub PrintPDFDocument()
Dim strDocument As String, strExecutable As String
    strPrinterName = Application.ActivePrinter
    strDriverName = GetPrinterDetails.DriverName
    strPortName = GetPrinterDetails.PortName
    strExecutable = GetExecutablePath("pdf") ' get the path to Acrobat Reader
    If Len(strExecutable) > 0 Then
        ' Set the current cell to A1
                   
        Range("I1").Activate
        ' Loop until we get to the end of the data
        Do While Not ActiveCell.Row = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            strDocument = ActiveCell.Cells.Value
            Shell strExecutable & " /p " & strDocument
            ' Can't seem to get the following bit of code to work for some reason
            ' Shell strExecutable & " /t " & strDocument & " " & strPrinterName & " " & strDriverName & " " & strPortName
            ActiveCell.Offset(1, 0).Range("I1").Select
            
        Loop
    End If
End Sub

Select allOpen in new window