VBA之文件筛选

最新推荐文章于 2024-01-18 20:54:38 发布

weixin_30794499

最新推荐文章于 2024-01-18 20:54:38 发布

阅读量244

点赞数

CC 4.0 BY-SA版权

原文链接：http://www.cnblogs.com/changxinblog/p/5361762.html

本文介绍了一种使用VBA批量筛选并复制特定文件的方法。通过简单的脚本设置，可以快速从源目录中根据指定列表筛选文件，并将这些文件复制到目标目录。同时，该脚本还会记录未找到的文件名。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

在工作中，经常会碰到从一堆腐朽的source中按照一个列表去筛选出来现在还要用的source文件。

这个如果用vba来实现的话，会节省大量的时间，而且不会出错。

前提说明：

将想要复制的文件名列表放在第一sheet的第一列，然后执行程序

首先选择源目录和目标目录，然后会从源目录中查找文件，将存在的文件自动复制的目标目录中，

不存在的文件，记录在第二列里。

Sub fileFilter()

    Dim folderOld As String
    Dim folderNew As String
    Dim fileNm As String
    Dim fileNmOld As String
    Dim fileNmNew As String
    Dim i As Integer
    Dim j As Integer
    j = 2
          
    MsgBox "Set before moving folder"
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            folderOld = .SelectedItems(1)
        End If
    End With
    MsgBox "Set after moving folder"
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            folderNew = .SelectedItems(1)
        End If
    End With
    
    For i = 1 To 1000
        fileNm = Worksheets(1).Cells(i, 1)
        If fileNm <> "" Then
            fileNmOld = folderOld & "\" & fileNm
            fileNmNew = folderNew & "\" & fileNm
            If Dir(fileNmOld) <> "" Then
                FileCopy fileNmOld, fileNmNew
            Else
                Worksheets(1).Cells(j, 2) = fileNm
                j = j + 1
            End If
        End If
    Next
    MsgBox "file filter over"
    
End Sub

另外，vba读取文件方法备用

Sub readFile()

 Dim txtLine
 Dim FileObj
 Dim TextObj
 Dim FilePath

 With Application.FileDialog(msoFileDialogFilePicker)
    If .Show = -1 Then
        FilePath = .SelectedItems(1)
    End If
 End With

 
  Dim txt As String
     Open FilePath For Input As #1
     Do While Not EOF(1)
         Line Input #1, txt
         MsgBox txt
      Loop
     Close #1

End Sub