Board logo

標題: [發問] 請教大大如果目錄存在略過不要複製，如何改，謝謝 [打印本頁]
作者: wufonna    時間: 2019-7-5 20:47     標題: 請教大大如果目錄存在略過不要複製，如何改，謝謝

本帖最後由 wufonna 於 2019-7-5 20:48 編輯
  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)

  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", "")



  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    時間: 2019-7-6 20:14

本帖最後由 wufonna 於 2019-7-6 20:18 編輯

回復 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

  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", "")

  16.     ReDim Preserve S(i)
  17.     S(i) = strPath
  18.   ' Debug.Print S(i)
  19.          myname = Dir

  21. i = i + 1
  22.     Loop


  25.     For Each m In S
  26. '    Debug.Print m

  28.      If Len(Dir(m, vbDirectory)) = 0 Then
  29.       MkDir m
  30.      End If
  31.     Next
  32.    
  33.    ' MsgBox n
  34. End Sub
複製代碼
作者: GBKEE    時間: 2020-4-26 17:18

回復 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
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)