- 帖子
- 38
- 主題
- 19
- 精華
- 0
- 積分
- 84
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office 2007
- 閱讀權限
- 20
- 性別
- 男
- 來自
- taichung
- 註冊時間
- 2011-7-6
- 最後登錄
- 2022-3-29
|
利用下列vba將數千個csv檔(同一資料夾內)依年度月份建立資料夾
想請問程式碼中#6列A = Mid(F, InStr(F, "2004")) 中2004為手動輸入(程式碼編輯視窗/偵錯/逐行) ,是否有其他方式可改善!
謝謝
Sub Ex()
Dim fs As Object, F As Object, A$, MyPath$
MyPath = ThisWorkbook.Path
Set fs = CreateObject("Scripting.FileSystemObject")
For Each F In fs.GetFolder(MyPath).Files
If InStr(F, ".csv") Then
A = Mid(F, InStr(F, "2004"))
'A = Replace(A, ".csv", "")
' A = Replace(A, "-", "\")
If fs.FolderExists(MyPath & "\" & Mid(A, 1, 4)) = False Then
ChDir MyPath
MkDir MyPath & "\" & Mid(A, 1, 4)
End If
If fs.FolderExists(MyPath & "\" & Mid(A, 1, 4) & "\" & Mid(A, 5, 2)) = False Then ChDir MyPath & "\" & Mid(A, 1, 4)
MkDir MyPath & "\" & Mid(A, 1, 4) & "\" & Mid(A, 5, 2)
End If
'If fs.FolderExists(MyPath & "\" & A) = False Then
'ChDir MyPath & "\" & Mid(A, 1, 7)
' MkDir MyPath & "\" & A
'End If
fs.moveFile F, MyPath & "\" & Mid(A, 1, 4) & "\" & Mid(A, 5, 2) & "\"
End If
Next
ChDir MyPath
End Sub |
|
發表於 2011-7-15 18:22
| 
