返回列表 上一主題 發帖

[發問] 如何建立指定資料夾和檔案拷貝改名

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
106  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-5-3 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2012-4-22 22:27 | 顯示全部帖子
回復 1# luke
  1. Sub nn()
  2. Set fso = CreateObject("Scripting.FileSystemObject")
  3. fd = ThisWorkbook.Path & "\"
  4. For Each a In Range("E2:E5")
  5. fn = fd & a & "\"
  6. fs = fn & a.Offset(, -2) & "\"
  7.    If fso.FolderExists(fn) = False Then MkDir fn
  8.    If fso.FolderExists(fs) = False Then MkDir fs
  9.    fso.copyfile fd & "P01\" & a.Offset(, -3) & ".csv", fn & a.Offset(, -2) & ".csv", True
  10.    fso.copyfile fd & "P01\" & a.Offset(, -3) & ".cbk", fn & a.Offset(, -2) & ".cbk", True
  11. Next
  12. End Su
複製代碼
學海無涯_不恥下問

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
106  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-5-3 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2012-4-22 23:25 | 顯示全部帖子
回復 3# luke

要改那些字?
   
學海無涯_不恥下問

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
106  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-5-3 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3#
發表於 2012-4-23 00:04 | 顯示全部帖子
回復 5# luke
  1. Sub nn()
  2. Dim A As Range
  3. Set fso = CreateObject("Scripting.FileSystemObject")
  4. fd = ThisWorkbook.Path & "\"
  5. For Each A In Range("E2:E5")
  6. fn = fd & A & "\"
  7. fs = fn & A.Offset(, -2) & "\"
  8.    If fso.FolderExists(fn) = False Then MkDir fn
  9.    If fso.FolderExists(fs) = False Then MkDir fs
  10.    Open fd & "P01\" & A.Offset(, -3) & ".cbk" For Input As #1
  11.    Open fn & A.Offset(, -2) & ".csv" For Output As #2
  12.    Open fn & A.Offset(, -2) & ".cbk" For Output As #3
  13.    Do Until EOF(1)
  14.    Line Input #1, mystr
  15.    If EOF(1) = True Then '更改最後一行資料
  16.       mystr = A.Offset(, -2)
  17.    End If
  18.    Print #2, mystr
  19.    Print #3, mystr
  20.    Loop
  21.    Close #1
  22.    Close #2
  23.    Close #3
  24. Next
  25. End Sub
複製代碼
學海無涯_不恥下問

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
106  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-5-3 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 2012-4-23 19:56 | 顯示全部帖子
回復 10# luke
cbk檔案是特殊的檔案格式，我以記事本開啟出現亂碼
如果其內容是與同名的csv檔案相同，就以讀取csv代替即可
學海無涯_不恥下問

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
106  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-5-3 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
5#
發表於 2012-4-23 21:39 | 顯示全部帖子
回復 12# luke
  1. Sub nn()
  2. Dim A As Range
  3. Set fso = CreateObject("Scripting.FileSystemObject")
  4. fd = ThisWorkbook.Path & "\"
  5. For Each A In Range("E2:E5")
  6. fn = fd & A & "\"
  7. fs = fn & A.Offset(, -2) & "\"
  8.    If fso.FolderExists(fn) = False Then MkDir fn
  9.    If fso.FolderExists(fs) = False Then MkDir fs
  10.    fso.copyfile fd & "P01\" & A.Offset(, -3) & ".csv", fn & A.Offset(, -2) & ".csv", True
  11.    fso.copyfile fd & "P01\" & A.Offset(, -3) & ".cbk", fn & A.Offset(, -2) & ".cbk", True
  12.    Open fn & A.Offset(, -2) & ".csv" For Binary As #1
  13.    n = FileLen(fd & "P01\" & A.Offset(, -3) & ".csv")
  14.    Seek #1, n - 9
  15.      For i = 1 To 8
  16.      Put #1, , Asc(Mid(A.Offset(, -2), i, 1))
  17.      Next
  18.    Close #1

  20.    Open fn & A.Offset(, -2) & ".cbk" For Binary As #1
  21.    n = FileLen(fd & "P01\" & A.Offset(, -3) & ".cbk")
  22.    Seek #1, n - 9
  23.      For i = 1 To 8
  24.      Put #1, , Asc(Mid(A.Offset(, -2), i, 1))
  25.      Next
  26.    Close #1
  27. Next
  28. End Sub
複製代碼
學海無涯_不恥下問

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
106  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-5-3 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 2012-4-23 23:37 | 顯示全部帖子
回復 14# luke
  1. Sub nn()
  2. Dim A As Range
  3. Set fso = CreateObject("Scripting.FileSystemObject")
  4. fd = ThisWorkbook.Path & "\"
  5. For Each A In Range("E2:E5")
  6. fn = fd & A & "\"
  7. fs = fn & A.Offset(, -2) & "\"
  8.    If fso.FolderExists(fn) = False Then MkDir fn
  9.    If fso.FolderExists(fs) = False Then MkDir fs
  10.    fso.copyfile fd & "P01\" & A.Offset(, -3) & ".csv", fn & A.Offset(, -2) & ".csv", True
  11.    fso.copyfile fd & "P01\" & A.Offset(, -3) & ".cbk", fn & A.Offset(, -2) & ".cbk", True
  12.    Open fn & A.Offset(, -2) & ".cbk" For Binary As #1
  13.    n = FileLen(fd & "P01\" & A.Offset(, -3) & ".cbk")
  14.      For i = 1 To 8
  15.      Seek #1, n - 10 + i
  16.      Put #1, , Asc(Mid(A.Offset(, -2), i, 1))
  17.      Next
  18.    Close #1
  19. Next
  20. End Sub
複製代碼
學海無涯_不恥下問

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
106  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-5-3 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
7#
發表於 2012-4-25 22:22 | 顯示全部帖子
回復 16# luke
  1. Sub nn()
  2. Dim A As Range, Ar(8) As Byte
  3. Set fso = CreateObject("Scripting.FileSystemObject")
  4. fd = ThisWorkbook.Path & "\"
  5. For Each A In Range("E2:E5")
  6. For i = 0 To 7
  7.   Ar(i) = Asc(Mid(A.Offset(, -2), i + 1, 1))
  8. Next
  9. fn = fd & A & "\"
  10. fs = fn & A.Offset(, -2) & "\"
  11.    If fso.FolderExists(fn) = False Then MkDir fn
  12.    If fso.FolderExists(fs) = False Then MkDir fs
  13.    fso.copyfile fd & "P01\" & A.Offset(, -3) & ".csv", fn & A.Offset(, -2) & ".csv", True
  14.    fso.copyfile fd & "P01\" & A.Offset(, -3) & ".cbk", fn & A.Offset(, -2) & ".cbk", True
  15.    Open fn & A.Offset(, -2) & ".cbk" For Binary As #1
  16.    n = FileLen(fd & "P01\" & A.Offset(, -3) & ".cbk")
  17.    Seek #1, n - 9
  18.        For j = 1 To 8
  19.          Put #1, , Ar(j - 1)
  20.        Next
  21.    Close #1
  22. Next
  23. End Sub
複製代碼
學海無涯_不恥下問

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
106  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-5-3 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
8#
發表於 2012-4-26 19:50 | 顯示全部帖子
回復 18# luke

道理一樣，只是你要想怎麼得到目錄的字串，自己先做做看，把遇到的問題再提出討論。
學海無涯_不恥下問

TOP

        靜思自在 : 看別人不順眼，是自己修養不夠。
返回列表 上一主題