[發問] 請教大大如果目錄存在略過不要複製，如何改，謝謝

wufonna

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim myPath As String, myFile As String, myname As String, n As Integer, strPath As String
   
4.     myPath = ThisWorkbook.Path & "\" 'myPath = ThisWorkbook.Path 檔案路
   
5.     myFile = "*.JPG"
   
6.     myname = Dir(myPath & myFile)
   
7. 
   
8.     Do While myname <> ""
   
9.         n = n + 1
   
10. '       Name myPath & myname As myPath & "FS" & Format(n, "00000") & ".jpg"
    
11. strPath = myPath & Replace(myname, ".jpg", "")
    
12. 
    
13. 
    
14. 
    
15.    MkDir strPath
    
16. '錯誤
    
17. 'If Len(Dir("c:\test\aaa", vbDirectory)) = 0 Then
    
18. ' MkDir "c\test\aaa"
    
19. 'End If
    
20. '
    
21.         myname = Dir
    
22.     Loop
    
23.     MsgBox n
    
24. End Sub

複製代碼

wufonna

回復 1# wufonna
改這樣可以，請教大大

1. Option Explicit
   
2. '批次改目錄
   
3. Sub Ex()
   
4.     Dim myPath As String, myFile As String, myname As String, n As Integer, strPath As String
   
5.     Dim S() As String, i As Integer, m As Variant
   
6.     myPath = ThisWorkbook.Path & "\" 'myPath = ThisWorkbook.Path 檔案路
   
7.     myFile = "*.JPG"
   
8.     myname = Dir(myPath & myFile)
   
9.     i = 0
   
10. 
    
11.     Do While myname <> ""
    
12.         n = n + 1
    
13. '       Name myPath & myname As myPath & "FS" & Format(n, "00000") & ".jpg"
    
14. strPath = myPath & Replace(myname, ".jpg", "")
    
15. 
    
16.     ReDim Preserve S(i)
    
17.     S(i) = strPath
    
18.   ' Debug.Print S(i)
    
19.          myname = Dir
    
20. 
    
21. i = i + 1
    
22.     Loop
    
23. 
    
24. 
    
25.     For Each m In S
    
26. '    Debug.Print m
    
27. 
    
28.      If Len(Dir(m, vbDirectory)) = 0 Then
    
29.       MkDir m
    
30.      End If
    
31.     Next
    
32.    
    
33.    ' MsgBox n
    
34. End Sub

複製代碼

GBKEE

回復 2# wufonna
'**Dir 會傳回第一個與_路徑名稱_相符的檔案名稱。 若要取得任何與_路徑名稱_相符的其他檔案名稱，請再次呼叫不含引數的 Dir
你附檔的程式碼有盲點    If Dir(strPath, vbDirectory) = "" Then MkDir strPath
'**上式程式碼再次使用 Dir(strPath, vbDirectory)   導致   myname = Dir 傳回空自字串

你這程式碼可以的
也可用FileSystemObject 物件 試試

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim myPath As String, myFile As String, myname As String, n As Variant, strPath As String
   
4.     Dim AR(), Folder As String
   
5.     myPath = ThisWorkbook.Path & "\" 'myPath = ThisWorkbook.Path 檔案路徑
   
6.     myFile = "*.JPG"
   
7.     myname = Dir(myPath & myFile, vbDirectory) ' 'Dir 尋找檔案路徑\ *.JPG"的檔案
   
8.     Do While myname <> ""
   
9.         strPath = myPath & Replace(myname, ".jpg", "")
   
10.         With New FileSystemObject  '引用項目 Microsoft Scripting Runtime
    
11.             On Error Resume Next    '表示當一個執行階段錯誤產生時，程式控制立刻到發生錯誤陳述式接下去的陳述式，而繼續執行下去
    
12.             If .GetFolder(strPath) Is Nothing Then MkDir strPath                                 '**加入圖片名稱的資料夾
    
13.             On Error GoTo 0                '停止現在程序裏任何已啟動的錯誤處理程式
    
14.         End With
    
15.         myname = Dir
    
16.     Loop
    
17. End Sub

複製代碼