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

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2019-7-5 20:47 | 顯示全部帖子

本帖最後由 wufonna 於 2019-7-5 20:48 編輯

Option Explicit
Sub Ex()
Dim myPath As String, myFile As String, myname As String, n As Integer, strPath As String
myPath = ThisWorkbook.Path & "\" 'myPath = ThisWorkbook.Path 檔案路
myFile = "*.JPG"
myname = Dir(myPath & myFile)
Do While myname <> ""
n = n + 1
' Name myPath & myname As myPath & "FS" & Format(n, "00000") & ".jpg"
strPath = myPath & Replace(myname, ".jpg", "")
MkDir strPath
'錯誤
'If Len(Dir("c:\test\aaa", vbDirectory)) = 0 Then
' MkDir "c\test\aaa"
'End If
'
myname = Dir
Loop
MsgBox n
End Sub

複製代碼

2^#

發表於 2019-7-6 20:14 | 顯示全部帖子

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

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

Option Explicit
'批次改目錄
Sub Ex()
Dim myPath As String, myFile As String, myname As String, n As Integer, strPath As String
Dim S() As String, i As Integer, m As Variant
myPath = ThisWorkbook.Path & "\" 'myPath = ThisWorkbook.Path 檔案路
myFile = "*.JPG"
myname = Dir(myPath & myFile)
i = 0
Do While myname <> ""
n = n + 1
' Name myPath & myname As myPath & "FS" & Format(n, "00000") & ".jpg"
strPath = myPath & Replace(myname, ".jpg", "")
ReDim Preserve S(i)
S(i) = strPath
' Debug.Print S(i)
myname = Dir
i = i + 1
Loop
For Each m In S
' Debug.Print m
If Len(Dir(m, vbDirectory)) = 0 Then
MkDir m
End If
Next
' MsgBox n
End Sub

複製代碼

靜思自在 : 話多不如話少，話少不如話好。