[VB.net]如何讓資料夾複製（包含子資料夾）時可「篩選檔名」

2011-09-02

6490
0
VB.net

有時會想要複製整個資料夾（包含子資料夾）但又想只針對特定的檔案做出動作，可以這樣做：

程式碼：


Imports System.IO
Imports System.Text
Public Class Form1
    WithEvents 複製器 As New 資料夾複製
    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
        txt_狀態區.Text = ""
        With 複製器
            .來源資料夾 = "d:\tmp"
            .目的資料夾 = "d:\tmp-1"
            .檔案名稱_篩選 = "*.exe|*.dll"
            .進行複製()
        End With
    End Sub
    Private Sub 資料夾複製_狀況通知(ByVal Message As String, ByVal sender As Object) Handles 複製器.狀況通知
        txt_狀態區.Text &= Message
    End Sub
End Class
Public Class 資料夾複製
#Region "欄位區"
    Private new來源資料夾 As String
    Private new目的資料夾 As String
    Private new檔案名稱_篩選 As New List(Of String)
    Private msg_例外記錄 As String = ""
    Public Event 狀況通知(ByVal Message As String, ByVal sender As Object)
#End Region
#Region "屬性區"
    Public Property 來源資料夾() As String
        Get
            Return new來源資料夾
        End Get
        Set(ByVal value As String)
            new來源資料夾 = value
        End Set
    End Property
    Public Property 目的資料夾() As String
        Get
            Return new目的資料夾
        End Get
        Set(ByVal value As String)
            If value <> "" Then value &= IIf(value.Last = "\", "", "\")
            new目的資料夾 = value
        End Set
    End Property
    Public Property 檔案名稱_篩選() As String
        Get
            Return String.Join("|", new檔案名稱_篩選)
        End Get
        Set(ByVal value As String)
            If value = "" Then value = "*.*"
            new檔案名稱_篩選 = Split(value, "|").ToList()
        End Set
    End Property
#End Region
#Region "方法區"
    Sub New()
        檔案名稱_篩選 = "*.*"
    End Sub
    Public Sub 進行複製()
        msg_例外記錄 = ""
        遞回複製(new來源資料夾)
        If msg_例外記錄 = "" Then
            RaiseEvent 狀況通知(vbNewLine & "作業完成...", Me)
        End If
    End Sub
    Private Sub 遞回複製(ByVal 原始資料夾 As String)
        Dim m As String = ""
        Try
            '---檢查目錄（若目錄不在就新建）---
            Dim 來源父目錄 = FileIO.FileSystem.GetDirectoryInfo(new來源資料夾).Parent.FullName
            Dim 目的資料夾 = Replace(原始資料夾, 來源父目錄, new目的資料夾)
            If Not FileIO.FileSystem.DirectoryExists(目的資料夾) Then
                FileIO.FileSystem.CreateDirectory(目的資料夾)
                Dim tmp = 目的資料夾.Replace(CurDir, ".")
                m = "CreateDir " & tmp & vbNewLine
                RaiseEvent 狀況通知(m, Me)
            End If
            Dim 當下資料夾 = New DirectoryInfo(原始資料夾)
            '---複製檔案---
            For Each F In new檔案名稱_篩選  '-------- 處理檔案名稱_Filter 的所有項目
                Dim 要複製的檔案() = 當下資料夾.GetFiles(F)
                For Each 檔案 In 要複製的檔案
                    Dim tmp = 檔案.FullName.Replace(CurDir, "‧")
                    Dim tmp1 = 目的資料夾.Replace(CurDir, "‧")
                    m = "Copy " & tmp & " → " & tmp1 & 檔案.Name & vbNewLine
                    FileIO.FileSystem.CopyFile(檔案.FullName, 目的資料夾 & "\" & 檔案.Name, True)
                    RaiseEvent 狀況通知(m, Me)
                Next
            Next
            '---遞回處理子目錄---
            Dim 要搜尋的子目錄() = 當下資料夾.GetDirectories("*.*", SearchOption.AllDirectories)
            For Each 子目錄 In 要搜尋的子目錄
                遞回複製(子目錄.FullName)
            Next
        Catch ex As Exception
            msg_例外記錄 = ex.Message
            MsgBox(msg_例外記錄)
        End Try
    End Sub
#End Region
End Class

測試看看：

以下測試把 d:\tmp 複製到 D:\tmp-1\tmp …

ku3

回首頁