執行此代碼時遇到錯誤。如果目標檔案夾中已存在檔案，則會出錯。如果檔案不存在，它會將檔案順利移動到更新的日期檔案夾中。
任何人都可以幫忙，以防目標檔案夾中已存在檔案，代碼不會出錯。它可以用新檔案替換檔案，也可以保留在 Source 檔案夾中。
Sub moveAllFilesInDateFolder()
Dim DateFold As String, fileName As String
Const sFolderPath As String = "E:\Uploading\Source"
Const dFolderPath As String = "E:\Uploading\Archive"
DateFold = dFolderPath & "\" & Format(Date, "ddmmyyyy") ' create the folder if it does not exist
If Dir(DateFold, vbDirectory) = "" Then MkDir DateFold
fileName = Dir(sFolderPath & "\*.*")
Do While fileName <> ""
Name sFolderPath & "\" & fileName As DateFold & "\" & fileName
fileName = Dir
Loop
End Sub
這將不勝感激。
uj5u.com熱心網友回復：
請使用這個更新的代碼。您不能Dir（再次）使用來檢查檔案是否存在，因為它會擾亂現有的回圈。因此，應該使用 VBScript 物件。命名將不再進行。Name方法無法覆寫現有檔案：
Sub moveAllFilesInDateFolderIfNotExist()
Dim DateFold As String, fileName As String, objFSO As Object
Const sFolderPath As String = "E:\Uploading\Source"
Const dFolderPath As String = "E:\Uploading\Archive"
DateFold = dFolderPath & "\" & Format(Date, "ddmmyyyy") ' create the folder if it does not exist
If Dir(DateFold, vbDirectory) = "" Then MkDir DateFold
fileName = Dir(sFolderPath & "\*.*")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Do While fileName <> ""
If Not objFSO.FileExists(DateFold & "\" & fileName) Then
Name sFolderPath & "\" & fileName As DateFold & "\" & fileName
End If
fileName = Dir
Loop
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/526510.html
標籤：vba
上一篇：MSpowerpoint中的VBA洗掉每張幻燈片上的文本框
下一篇：返回列表