[發問] VBA 輸入日期 讀取檔案後分類放進資料夾

mark126

我現在有很多檔案在C:\app 裡 檔案名稱為arlm_yyyy-mm-dd.csv
yyyy=年 mm=月 dd=日
我想用vba的巨集做出 輸入 年 月 日  然後去讀檔後在依輸入的年月日依序建立資料夾
資料夾為 年\月\日\檔案 例: C:\app \2011\05\19\arlm_2011-05-19.csv

抱歉沒很完整敘述
在補充一下 檔案名稱arlm是固定的只有yyyy mm dd在變
我想要的是用text box 開起巨集後再text box輸入yyyy、mm、dd
text box應該有三個分別為yyyy、mm、dd用來讀檔及建資料夾用

大概流程圖   開始→輸入 年月日→按下轉檔按鈕→讀取C:\app\arlm_yyyy-mm-dd.csv →轉檔*.xls→
                 →按下搬移按鈕→依yyyy、mm、dd建資料夾後放進檔案→案離開按鈕→結束
所以剛開始介面應該會有 轉檔按鈕、搬移按鈕、離開按鈕及三個輸入格

mark126

回復 2# GBKEE


    大大真的很厲害~感謝你!!

mark126

回復 2# GBKEE


    檔案是*.CSV 抱歉

GBKEE

回復 1# mark126
試試看

1. Sub Ex()  '複製的檔案,巨集的活頁簿,父層資料夾相同的程式碼
   
2.     Dim fs As Object, F As Object, A$, MyPath$
   
3.     MyPath = ThisWorkbook.Path                            '這活頁簿的資料夾名稱
   
4.     Set fs = CreateObject("Scripting.FileSystemObject")   '提供對電腦檔案系統的存取的物件
   
5.     For Each F In fs.GetFolder(MyPath).Files
   
6.         '****   asv 這副檔名沒見過  **********
   
7.         If InStr(F, "_") And InStr(F, ".asv") Then    '檔案名稱中尋找 "_" 副檔名 ".asv"
   
8.             A = Mid(F, InStr(F, "_") + 1)             '取的"_"之後的字串
   
9.             A = Replace(A, ".xls", "")                '刪掉副檔名
   
10.             A = Replace(A, "-", "\")                  '替換"-"為"\"
    
11.             If fs.FolderExists(MyPath & "\" & Mid(A, 1, 4)) = False Then '找不到[年度]的資料夾
    
12.                 ChDir MyPath                          '改變目前的目錄或檔案夾 到 MyPath
    
13.                 '如複製的檔案目的地與,巨集的活頁簿,父層資料夾不相同,可另設一變數取代 MyPath
    
14.                 MkDir Mid(A, 1, 4)                    '建立一個新的目錄或檔案夾。
    
15.             End If
    
16.             If fs.FolderExists(MyPath & "\" & Mid(A, 1, 7)) = False Then '找不到[年度月份]的資料夾
    
17.                 ChDir MyPath & "\" & Mid(A, 1, 4)
    
18.                 MkDir MyPath & "\" & Mid(A, 1, 7)
    
19.             End If
    
20.             If fs.FolderExists(MyPath & "\" & A) = False Then   '找不 [年度月份日期]的資料夾
    
21.                 ChDir MyPath & "\" & Mid(A, 1, 7)
    
22.                 MkDir MyPath & "\" & A
    
23.             End If
    
24.             fs.CopyFile F, MyPath & "\" & A & "\"   '複製檔案到 指定的路徑
    
25.         End If
    
26.     Next
    
27.     ChDir MyPath                                    '回到原目錄
    
28. End Sub

複製代碼