★創意檔案複製管理★

linyancheng

創意檔案複製管理v1.0簡要說明

一、核心功能

依賴Excel工作表強大的編輯功能進行檔案篩選及檔案路徑修改，現有的進階複製軟體的篩選功能皆難以望其項背。
配合程式設計的簡易篩選功能，加上直接由檔案列表開啟檔案及瀏覽圖片的功能，可方便快速地進行各種檔案篩選。
可將來自不同目錄的檔案匯集起來，複製或移動至一處，並可保留原始路徑。也可以進行刪除。
複製、移動及刪除時也可以進行簡易的篩選，也可以選擇強制與否。
可以調整部分路徑至來源資料夾，也可調整來源資料夾至路徑，只有路徑的部分可以保留至目的資料夾，來源資料夾不會保留，所以可以調整要保留多少路徑。同一工作表使用同一個來源資料夾。

二、原創功能

完成篩選及路徑修改的成果可儲存於工作表以重複使用。
當檔案路徑變更，可於工作表修改其路徑，變更來源資料夾，最後可以檢查來源檔是否存在，也可以變更目的資料夾，檢查目的檔是否存在。
若篩選照片製作網頁、相簿、專輯等，只要保留成果工作表，不必保留篩選後複製的檔案，就可以重複篩選出檔案。
保留成果工作表也很適合使用於經常性的備份檔案。

三、附屬功能

製作CD、DVD、磁碟、目錄的檔案索引清單。
簡易瀏覽圖片。
方便複製任何已存檔的活頁簿。


創意檔案複製管理v1.0.exe
Size: 790229 bytes
Modified: 2010年4月11日, 下午 10:56:16
MD5: 9D32EB5F3A0A52141CECFA69C245925E
SHA1: 6C9FAA44ABAC34D813B983F40F48A437EDC8EDD7
CRC32: 518A85B1

[ 本帖最后由 linyancheng 于 2010-4-12 23:13 编辑 ]

linyancheng

Option Explicit
Option Base 1
Option Compare Text

Private 檔案系統 As Object
Private 檔案資訊陣列() As String

Sub 搜尋檔案(資料夾路徑 As String, 篩選檔名 As String, 包含子資料夾 As Boolean)

    On Error Resume Next
   
    Dim X As Long
    Dim Y As Long
    Dim N As Long
    Dim K As Long
    Dim F As Long
    Dim 檔名 As String
    Dim 資料夾路徑陣列() As String

    Set 檔案系統 = CreateObject("Scripting.FileSystemObject")
   
    ReDim 資料夾路徑陣列(256, 1) As String

    資料夾路徑陣列(1, 1) = 資料夾路徑
   
    N = 0
    F = 1
    For X = 1 To 256
        If Not 資料夾路徑陣列(X, 1) = "" Then
            K = 0
            For Y = 1 To F
                If Not 資料夾路徑陣列(X, Y) = "" Then
                    檔名 = Dir(資料夾路徑陣列(X, Y) & "*", 31)
                    
                    Do Until 檔名 = ""
                        If Not 檔名 = "." And Not 檔名 = ".." Then
                            If (GetAttr(資料夾路徑陣列(X, Y) & 檔名) And vbDirectory) = vbDirectory Then
                                If 包含子資料夾 = True Then
                                    K = K + 1
                                    
                                    If K > F Then
                                        F = F + 1
                                        ReDim Preserve 資料夾路徑陣列(256, F) As String
                                    End If
                                    
                                    資料夾路徑陣列(X + 1, K) = 資料夾路徑陣列(X, Y) & 檔名 & "\"
                                End If
                            Else
                                If 檔名 Like 篩選檔名 Then
                                    N = N + 1
                                    Application.StatusBar = "搜尋檔案中......第 " & N & " 筆　" & 檔名
                                    ReDim Preserve 檔案資訊陣列(7, N) As String
                                    
                                    檔案資訊陣列(1, N) = 資料夾路徑陣列(X, Y) & 檔名
                                    檔案資訊陣列(2, N) = FileLen(資料夾路徑陣列(X, Y) & 檔名)
                                    檔案資訊陣列(3, N) = "'" & 檔案系統.GetExtensionName(資料夾路徑陣列(X, Y) & 檔名)
                                    檔案資訊陣列(4, N) = "'" & Application.WorksheetFunction.Text(FileDateTime(資料夾路徑陣列(X, Y) & 檔名), "yyyy/mm/dd hh:mm:ss")
                                    
                                    If (GetAttr(資料夾路徑陣列(X, Y) & 檔名) And vbReadOnly) = vbReadOnly Then
                                        檔案資訊陣列(5, N) = "R"
                                    End If
                                    
                                    If (GetAttr(資料夾路徑陣列(X, Y) & 檔名) And vbHidden) = vbHidden Then
                                        檔案資訊陣列(5, N) = 檔案資訊陣列(5, N) & "H"
                                    End If
                                    
                                    If (GetAttr(資料夾路徑陣列(X, Y) & 檔名) And vbSystem) = vbSystem Then
                                        檔案資訊陣列(5, N) = 檔案資訊陣列(5, N) & "S"
                                    End If
                                    
                                    If (GetAttr(資料夾路徑陣列(X, Y) & 檔名) And vbArchive) = vbArchive Then
                                        檔案資訊陣列(5, N) = 檔案資訊陣列(5, N) & "A"
                                    End If
                                    
                                    檔案資訊陣列(6, N) = 資料夾路徑陣列(X, Y)
                                    檔案資訊陣列(7, N) = "'" & 檔名
                                End If
                            End If
                        End If
                        
                        檔名 = Dir
                    Loop
                Else
                    Exit For
                End If
            Next Y
        Else
            Exit For
        End If
    Next X
   
    Application.StatusBar = "完成搜尋，共 " & N & " 筆"

End Sub

一丝不苟

有个性,正是本人的部分设想,谢谢楼楼主的杰作!