Vba 检查文件是否以列表中的值开头，如果不是则将其杀死

Question

在我永无止境的学习故事中VBA我正在尝试创建一个宏来根据文件的起始字符删除文件，但不确定如何继续。

我有一个 excel 文件，其中 a 列中有数字，这些数字是 4,5 或 6 位数字。我有一个文件夹，其中的文件可能以 excel 文件范围内的这些数字开头，也可能不以这些数字开头。这些文件夹中的文件是不同类型的
但我认为这可能仍然不是问题，命名约定如下：即。 4563_listofitems.pdf,65475_skusdec.doc等

我的目标是遍历文件并检查文件的起始字符是否包含在 excel sheet 的 A 范围内，如果是（最多可能有 6 个以此类数字开头的文件）创建一个以找到的起始字符命名的文件夹，并将以这些字符开头的文件移动到该文件夹中，否则如果文件不是以列表中的固定字符开头，则只需删除（杀死）该文件。我的问题是如何根据列表检查文件名。

我现在的循环槽代码

Sub loopf

Dim filen as variant
Filen =dir("c:\test\")
While filen <>""

If instr(1,filen,10000)=1 then
'Here I want check against the values from range but unsure how ,should I somehow loop through the range ?


Filen=dir
End if
Wend
End sub

Answer 1

Sub Files()
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim i As Integer
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("C:\test") 
For Each oFile In oFolder.Files
    'do somthing
Next oFile
End Sub

Answer 2

要检查某个值是否包含在已知列表中，我喜欢使用 Dictionary 对象。它有函数 Exists 检查一个值是否在字典中列出。

因此，在循环遍历文件之前，您只需将接受的每个数字添加到字典中即可。然后在循环文件时检查是否 Dictionary.Exists(Value)。如果存在，那么这个值就是好的，如果不存在那么Kill.

以下是我的设置方式：

Sub loopf()
    Dim AcceptedPrefixes As Object
    Set AcceptedPrefixes = CreateObject("Scripting.Dictionary")
    
    Dim PrefixRange As Range
    Set PrefixRange = ThisWorkbook.Sheets(1).Range("A1:A5")
    
    Dim Cell As Range
    For Each Cell In PrefixRange.Cells
        If Cell <> "" And Not AcceptedPrefixes.exists(Cell.Value) Then
            AcceptedPrefixes.Add CStr(Cell.Value), 0
        End If
    Next

    Dim Directory As String
    Directory = "c:\test\"

    Dim filen As Variant
    filen = Dir(Directory)
    While filen <> ""
        Dim FilePrefix As String
        FilePrefix = Split(filen, "_")(0)
        
        If Not AcceptedPrefixes.exists(FilePrefix) Then
            Kill Directory & filen
        End If
        
        filen = Dir
    Wend
End Sub

Vba 检查文件是否以列表中的值开头，如果不是则将其杀死

Vba check if file starts with values from list and if not kill it

vba

while-loop

delete-file