VBA：Excel宏删除文件，除非文件名包含单元格内容中的字符串

Question

试图构建我的第一个VBA应用程序。我想要实现的是：

• 值列在A列中
• VBA查找设置文件目录
• 将文件目录中的内容与A列中的值进行比较。
• 如果文件名没有类似于A列中列出的字符串，则删除该文件。

我试图拼凑出互联网上列出的一些想法，但一直陷入困境。这是我到目前为止所拥有的。

Private Sub CommandButton1_Click()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object

Dim strArray() As String
Dim TotalRows As Long
Dim i As Long

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Users\z002vbrx\Desktop\test1")

TotalRows = Rows(Rows.Count).End(xlUp).Row
    ReDim strArray(1 To TotalRows)

    For i = 1 To TotalRows
        strArray(i) = Cells(i, 1).Value
    Next
Debug.Print "Loaded " & UBound(strArray) & " items from speadsheet"

For Each objFile In objFolder.Files
   If InStr(1, objFile.Name, strArray) > 0 Then
       Debug.Print "something is being selected to be deleted."

      End If
   Next

MsgBox "Complete"
End Sub

我遇到的是，strArray假设要抓取电子表格中的所有数据并创建一个数组。但是当我尝试将该数组传递给任何东西时，我总是会遇到类型不匹配错误。我甚至不确定比较并最终删除文件的代码的后半部分是否适用于数组。我知道它确实适用于单个值。

Answer 1

就像Tim提到的那样，你需要遍历数组strArray中的每个元素并将其与文件名进行比较。您还需要修改比较值，因为如果当前元素不是文件名的一部分，InStr将返回0。如果它返回> 0，我建议让它突破检查。

Answer 2

这是我提出的解决方案，希望这可以帮助其他人！如果您对如何改进代码有任何建议，请与我们联系。

这将扫描Sheet1 E3上提供的文件夹位置文件名将添加到Sheet2列A Sheet1列A中的每个单元格的字符串将与Sheet 2列A进行比较并标记为Good然后，未标记为Good的任何内容都将标记为Bad最后，我们扫描Sheet2 A列，查找标记为Bad的单元格，并将名称与文件进行比较并删除文件。

Private Sub CommandButton1_Click()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim j As Long
Dim l As Long
Dim lr1 As Long
Dim lr2 As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ws1.Cells(3, 5).Value)
i = 1

'Scan through the folder and list files in Sheet2, column A
For Each objFile In objFolder.Files
    ws2.Cells(i + 1, 1) = objFile.Name
    i = i + 1
Next objFile

'Setup the sheets
lr1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
lr2 = ws2.Range("A" & Rows.Count).End(xlUp).Row

For l = 2 To lr1
    ws1.Cells(l, 1).Style = "normal"
Next l

For j = 2 To lr2
    ws2.Cells(j, 1).Style = "normal"
Next j

'Check cell string in Sheet1 column A against file names
'in Sheet2 column A and flag both Good
For l = 2 To lr1
cell1 = ws1.Cells(l, 1).Value
    For j = 2 To lr2
    cell2 = ws2.Cells(j, 1).Value
    If InStr(1, cell2, cell1) > 0 Then
        ws1.Cells(l, 1).Style = "Good"
        ws2.Cells(j, 1).Style = "Good"
        End If
    Next j
Next l

'Scan both Sheets 1 and 2 for unmarked cells and flag Bad
For l = 2 To lr1
style1 = ws1.Cells(l, 1).Style
    If style1 = "Normal" Then
        ws1.Cells(l, 1).Style = "Bad"
    End If
Next l

For j = 2 To lr2
style2 = ws2.Cells(j, 1).Style
    If style2 = "Normal" Then
        ws2.Cells(j, 1).Style = "Bad"
        End If
Next j

'Delete files if Sheet2 Column A cells are marked Bad and the
'cell string matches the file name
For j = 2 To lr2
    cell2 = ws2.Cells(j, 1).Value
    style2 = ws2.Cells(j, 1).Style
    For Each objFile In objFolder.Files
        If style2 = "Bad" And objFile.Name = cell2 > 0 Then
            Kill objFile
            End If
        Next objFile
Next j


MsgBox "Complete"
End Sub