返回列表 上一主題 發帖

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

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

各位大大

sheet1表B欄資料為文字檔(*.csv 和cbk)的檔案主名字, C欄是欲拷貝和更名的名稱, E欄是欲建立的資料夾名字

如何將B欄資料所對應的P01資料夾同名文字檔(*.csv 和cbk)進行拷貝並改名成C欄所對應的名稱

再行至E欄名字去建立新的資料夾,
然後依照E欄所對應資料去見立子資料夾和移轉改名後的檔案

煩請先進 大大指導
TEST14.rar (59.44 KB)

本帖最後由 luke 於 2012-4-30 19:26 編輯

回復 19# Hsieh


   謝謝

TOP

本帖最後由 luke 於 2012-4-30 19:27 編輯

回復 19# Hsieh


    謝謝

TOP

回復 18# luke

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

TOP

本帖最後由 luke 於 2012-4-30 19:27 編輯

[attach]10686[/attach]回復 17# Hsieh

謝謝

TOP

回復 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

本帖最後由 luke 於 2012-4-30 19:29 編輯

回復 15# Hsieh


當AA-1.cbk檔改名成00011112.cbk檔後(如"上次結果"資料夾),
於第8位數字後面多了兩個空白格(如ASCII碼小黑框),
研判是byte計算錯誤,

請問如何修改原始碼程式?
煩請先進 大大指導
TEST14D.rar (324.37 KB)

TOP

回復 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

回復 13# Hsieh


    謝謝H大

     *.csv是原始資料不需作改名, 只需進行*.cbk最後一列數字替換改名.

    改名後檔案內容和大小OK, 但*.cbk檔每個數字後面多了乙個"空白"
    如第1張圖, 正確應為第2張圖應為位置計算錯誤.

    請問如何修改原程式?

     煩請先進 大大指導
    TEST14C.rar (56.77 KB)

TOP

回復 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

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

TOP

        靜思自在 : 有時當思無時苦,好天要積雨來糧。
返回列表 上一主題