Question

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

有没有办法通过VBA根据标题中的文字找到这124个文件并将其排序到新文件夹中？文本字符串必须完全匹配吗？或者我是否需要在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

用于将HTML文件排序到文件夹的VBA代码

1 个答案: