1
 2
 3
 4
 5
 6
 7
 8
 9
10
11

Sub ShowFileList(folderspec)
    Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderspec)
    Set fc = f.Files
    For Each f1 in fc
        s = s & f1.name 
        s = s &  vbCrLf
    Next
    MsgBox s
End Sub

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

Public Sub 移動特定檔案到特定資料夾2()
    Dim oFSO As Object
    Dim oFolder As Object
    Dim oFile As Object
    Dim xlsx As Variant
    Dim filePath As String
    Dim oldPath As String
    Dim newPath As String
   
    
    filePath = ThisWorkbook.Path
    Debug.Print filePath

    ' 建立 FileSystemObject 物件
    Set oFSO = CreateObject("Scripting.FileSystemObject")

    ' 建立目錄物件
    Set oFolder = oFSO.GetFolder(filePath & "\")


    ' 以迴圈列出所有檔案
     For Each oFile In oFolder.Files
        
        xlsx = Split(oFile.Name, ".")   '用.來分割完整檔案名稱
        
        Debug.Print xlsx(1)             'xlsx(0)檔案名稱 xlsx(1)副檔名
        
        If xlsx(1) = "xlsx" Then        '只取副檔名為xlsx的檔案
            
            oldPath = oFile.Path
            newPath = ThisWorkbook.Path & "\" & xlsx(0) & "-資料夾"        '自訂目標資料夾路徑
                
            If Dir(newPath, vbDirectory) <> "" Then                            '判斷資料夾是否存在
            
                Debug.Print "cmd.exe /c move /Y " & Chr(32) & oldPath & Chr(32) & newPath
            
                Shell "cmd.exe /c move /Y " & Chr(32) & oldPath & Chr(32) & newPath     '執行cmd的move
            Else
                MkDir newPath                                                   '不存在則建立
                Debug.Print "cmd.exe /c move /Y " & Chr(32) & oldPath & Chr(32) & newPath
            
                Shell "cmd.exe /c move /Y " & Chr(32) & oldPath & Chr(32) & newPath     '執行cmd的move
            End If

        End If

     Next oFile
      
End Sub