返回列表 上一主題 發帖

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

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 滴水成河。粒米成蘿，勿輕己靈，勿以善小而不為。
返回列表 上一主題