暱稱: 隨風飄蕩的羽毛 頭銜: [御用]潛水艇
高中生 
- 帖子
- 852
- 主題
- 79
- 精華
- 0
- 積分
- 918
- 點名
- 0
- 作業系統
- Windows 7 , XP
- 軟體版本
- Office 2007, Office 2003,Office 2010,YoZo Office
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 宇宙
- 註冊時間
- 2011-4-8
- 最後登錄
- 2024-2-21
|
這是可以將檔案 快速放置所要的目錄底下
如果資料很多 手動去搬移的話 會手痠
故以此來做簡單設定後 讓檔案回到該回去的地方
如：
D:\文件\***-文件圖檔.jpg 要放在 ***資料夾底下的 EXCEL檔案
AAA-文件圖檔.jpg 搬移到 AAA\EXCEL\AAA-文件圖檔.JPG
使用方式：
A欄位輸入想要放置的資料夾名稱
且 該跟目錄下放置想搬移的檔案
執行程式碼即可
程式碼如下- Sub test()
- Dim objFs As Object
- Set objFs = CreateObject("Scripting.FileSystemObject")
- MkDir "D:\文件\" & Range("a" & wi).Value & "\" & "Excel" '在A欄位資料夾內創立 EXCEL資料夾
- MkDir "D:\文件\" & Range("a" & wi).Value & "\" & "圖片存放區" '在A欄位資料夾內創立 圖片存放區資料夾
- Columns("H:H").Select
- Selection.NumberFormatLocal = "@" '文字型態
- Columns("t:t").Select
- Selection.NumberFormatLocal = "@" '文字型態
- Range("h1").Value = Right(Range("e1").Value, 4)
- For xi = 1 To 999
- If Range("a" & xi).Value <> "" Then
- xy = xi
- End If
- Next
- For xt = 1 To xy
- xo = Range("j" & xt).Value
- Columns("H:H").Select
- Selection.NumberFormatLocal = "@"
- Range("h" & xt).Value = Right(Range("e" & xt).Value, 4)
-
- For xuo = 1 To 999
- If Dir("D:\文件\" & Range("e" & xuo).Value & "-文件圖檔.jpg") <> "" Then
- objFs.moveFile "D:\文件\" & Range("e" & xuo).Value & "-文件圖檔.jpg", "D:\文件\" & Range("a" & xuo).Value & "\excel\"
- End If
- Next xuo
- For xww = 1 To 999
- If Dir("D:\文件\" & Range("a" & xt).Value & Range("h" & xww).Value & ".jpg") <> "" Then
- objFs.moveFile "D:\文件\" & Range("a" & xt).Value & Range("h" & xww).Value & ".jpg", "D:\文件\" & Range("a" & xt).Value & "\圖片存放\"
- End If
- Next xww
- Next xt
- End Sub
|
|
發表於 2012-3-12 14:51
| 
