分享

VBA之文件筛选

 Excel实用知识 2021-11-21

在工作中,经常会碰到从一堆腐朽的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
复制代码

    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。
    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多