Просматривая папку / подпапки, чтобы найти и распечатать список PDF-файлов - PullRequest
0 голосов
/ 13 июля 2020

У меня есть список PDF-файлов, которые находятся в одной папке и подпапках внутри этой папки. Я хотел бы иметь макрос, который идет вниз по списку и печатает каждый из PDF-файлов после их нахождения в папках.

Список имен PDF-файлов в листе Excel начинается с B3 и go вниз. Выглядит как «10028844», в то время как PDF-файлы сохраняются с тем же именем «10028844.pdf».

Я осмотрелся и нашел много примеров того, как просматривать папки для ALL файлов в папке / подпапке, но ни один из них не ищет определенные c файлы или список файлов. Приветствуется любая помощь.

Я нашел несколько статей, которые помогли с некоторым кодом, добавив файлы в коллекцию, но когда я запускаю этот макрос, в коллекции ничего нет. Кто-нибудь видит, где это не так?

Sub GetFiles(StartFolder As String, Pattern As String, _
         DoSubfolders As Boolean, ByRef colFiles As Collection)

Dim f As String, sf As String, subF As New Collection, s

If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"

f = Dir(StartFolder & Pattern)
Do While Len(f) > 0
    colFiles.Add StartFolder & f
    f = Dir()
Loop

sf = Dir(StartFolder, vbDirectory)
Do While Len(sf) > 0
    If sf <> "." And sf <> ".." Then
        If (GetAttr(StartFolder & sf) And vbDirectory) <> 0 Then
                subF.Add StartFolder & sf
        End If
    End If
    sf = Dir()
Loop

For Each s In subF
    GetFiles CStr(s), Pattern, True, colFiles
Next s

End Sub

.

Sub BatchPrint()

Dim colFiles As New Collection
Dim CustRow, LastRow As Long

LastRow = Sheet1.Range("B9999").End(xlUp).Row

With Sheet1

For CustRow = 3 To LastRow

GetFiles "C:\Users\Desktop\Test\", "B" & CustRow & ".pdf", True, colFiles
If colFiles.Count > 0 Then
'work with found files
End If

Next CustRow

End With

Dim i As Long
For i = 1 To colFiles.Count
Debug.Print colFiles(i)
Next i

End Sub

1 Ответ

0 голосов
/ 14 июля 2020

После некоторой работы я, наконец, заставил это работать. Код ниже. Выберите, что произойдет с коллекцией, изменив строку Debug.Print colFiles (i) .

Sub GetFiles(StartFolder As String, Pattern As String, _
         DoSubfolders As Boolean, ByRef colFiles As Collection)

Dim f As String, sf As String, subF As New Collection, s

If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"

f = Dir(StartFolder & Pattern)
Do While Len(f) > 0
    colFiles.Add StartFolder & f
    f = Dir()
Loop

sf = Dir(StartFolder, vbDirectory)
Do While Len(sf) > 0
    If sf <> "." And sf <> ".." Then
        If (GetAttr(StartFolder & sf) And vbDirectory) <> 0 Then
                subF.Add StartFolder & sf
        End If
    End If
    sf = Dir()
Loop

For Each s In subF
    GetFiles CStr(s), Pattern, True, colFiles
Next s

End Sub

.

Sub BatchPrint()

Dim colFiles As New Collection
Dim CustRow, LastRow As Long

Set colFiles = New Collection

LastRow = Sheet1.Range("B9999").End(xlUp).Row

With Sheet1

For CustRow = 3 To LastRow

GetFiles "C:\Users\Desktop\Test\", Sheet1.Range("B" & CustRow) & ".pdf", True, colFiles

Next CustRow

End With

Dim i As Long
For i = 1 To colFiles.Count
    Debug.Print colFiles(i)
Next i

Set colFiles = Nothing

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...