将HTML文件分类到文件夹的VBA代码

我有一个包含124个唯一HTML文件列表的电子表格和一个包含1,517个HTML文件的文件夹，其中包括电子表格中的124个文件。

有没有办法，通过VBA，find并根据他们的标题中的文本这124个文件到一个新的文件夹？ 文本string是否必须完全匹配？ 或者我需要在Excel以外的代码？

这段代码是目前为止我能得到的最好的代码：

Sub Copy_Certain_Files_In_Folder() Dim FSO As Object Dim FromPath As String Dim ToPath As String Dim FileExt As String FromPath = "C:\Users\Benjamin\Desktop\to_classify" ToPath = "C:\Users\Benjamin\Desktop\to_classify\Ben.Proxy.1" FileExt = "*.htm*" If Right(FromPath, 1) <> "\" Then FromPath = FromPath & "\" End If Set FSO = CreateObject("scripting.filesystemobject") If FSO.FolderExists(FromPath) = False Then MsgBox FromPath & " doesn't exist" Exit Sub End If If FSO.FolderExists(ToPath) = False Then MsgBox ToPath & " doesn't exist" Exit Sub End If FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath MsgBox "You can find the files from " & FromPath & " in " & ToPath End Sub 

这很好，但我想添加一个标识打开的工作簿中列出的特定htm文件， 只移动这些特定的文件。 这将是类似rFileToMatch = wsSource.Range("A2:A125") ，但我不知道在代码中的位置。 我将如何纳入这个元素？

Answer 1

就是这样

 A2 = myfile1.html A3 = myfile2.html A4 = myfile3.html Public Sub copyFiles() Dim wsSource As Excel.Worksheet Dim sCopyFrom As String, sCopyTo As String Dim lFiles As Long, lLastSourceRow As Long Dim rFileToMatch As Range Dim vbFile As Variant On Error Resume Next '---------- set up your data here sCopyFrom = "C:\CopyFromFolder\" sCopyTo = "C:\CopyToFolder\" Set wsSource = ThisWorkbook.Sheets("Sheet1") rFileToMatch = wsSource.Range("A2:A100") ' range with file names to copy For Each vbFile In rFileToMatch '---------- no file extension for files to copy! MsgBox sCopyFrom & vbFile ' look how look your path to file If (Len(Dir(sCopyFrom & vbFile)) > 0) Then lFiles = lFiles + 1 FileCopy sCopyFrom & vbFile, sCopyTo & vbFile End If Next MsgBox lFiles & " files copied.", vbInformation, "Copy Files" End Sub