时间戳

首页 > 解决方案 > 将项目添加到集合时更改单元格颜色

excel - 将项目添加到集合时更改单元格颜色

问题描述

目前，我有一个宏，可以查找随机放入文件夹/子文件夹中的文件，如果通过阅读 B 列中的列表找到它们，则打开它们。它工作得很好，但如果该文件不存在，它只会跳过单元格，如果找不到，我想更改单元格的颜色。代码的上半部分来自其他人，我尝试过修改它，但找不到让这种情况发生的方法。它不会添加不存在的文件路径，而是跳过它。

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
FollowHyperlink colFiles(i)

Next i

Set colFiles = Nothing

End Sub

标签： excelvba

解决方案

我只是在代码中添加了一些行。在变量 countFiles 中，在获取下一个文件之前存储找到的文件的数量。如果未找到，则保留找到的文件数。在这种情况下，单元格将被着色。

Sub BatchPrint()

Dim colFiles As New Collection
Dim CustRow, LastRow As Long

Set colFiles = New Collection

LastRow = Sheet1.Range("B9999").End(xlUp).Row
Dim countFiles As Integer 'Storing the number of files found
With Sheet1

For CustRow = 3 To LastRow
countFiles = colFiles.Count
GetFiles "C:\Users\Desktop\Test\", Sheet1.Range("B" & CustRow) & ".pdf", True, colFiles
If countFiles = colFiles.Count Then
'No new files, shall change the color of the cell
Sheet1.Range("B" & CustRow).Interior.ColorIndex = 3
End If
Next CustRow

End With

Dim i As Long
For i = 1 To colFiles.Count
FollowHyperlink colFiles(i)

Next i

Set colFiles = Nothing

End Sub

推荐阅读