Hsieh

回復 10# luke
cbk檔案是特殊的檔案格式，我以記事本開啟出現亂碼
如果其內容是與同名的csv檔案相同，就以讀取csv代替即可

luke

回復 11# Hsieh


    回覆H大

    *.cbk是以ASCII儲存的文字檔, , 因此讀取時會變成亂碼,  
    此檔是由同名的*.csv檔, 經過重新編譯加密而成,
   
    4#提供的程式僅未替換*.cbk檔案最後一列的密碼即sheet1表所對應的C欄值,
    以下是VB語法想改成VBA
       installpass = Worksheets("Sheet1").Cells(i, 3).Value
       Open newcsv For Binary As #1
       flen = FileLen(newcsv)
       For j = 1 To 8
       Put #1, , PassWD(j - 1)
       Next
       Close #1

如何插入這個語法?

煩請先進 大大指導

Hsieh

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

複製代碼

luke

回復 13# Hsieh


    謝謝H大

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

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

    請問如何修改原程式?

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

下載次數: 4

2012-4-23 22:45

Hsieh

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

複製代碼

luke

回復 15# Hsieh


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

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

下載次數: 3

2012-4-25 21:37

Hsieh

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

複製代碼

luke

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

謝謝

Hsieh

回復 18# luke

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

luke

回復 19# Hsieh


    謝謝