繁体   English   中英

VBA代码将HTML文件排序到文件夹

[英]VBA Code to Sort HTML Files into Folder

我有一个电子表格,其中包含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") ,但是我不确定将其放在代码中的什么位置。 我将如何合并这个元素?

像这样

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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM