Dùng excel để chuyển đổi tên nhiều file (1 người xem)

[nokia6230ivn]

Gởi các bác
Em co 1 file tổng hợp (gọi là master file), trong đó ghi các thông tin cơ bản và dùng hyperlink để link đến file trong cùng thư mục. Tuy nhiên sau 1 thời gian khá dài, hiện nay file này đã có hơn 6.000 dòng và sẽ tiếp tục dài thêm theo thời gian. Em thấy như vậy sẽ không ổn về lâu dài. (file đính kèm)
Giờ em muốn chuyển cách lưu trữ mới bằng cách đổi toàn bộ tên file (docxxx.pdf) thành các file tương ứng có dạng như sau: yymmdd + "Dự án" + "Số công văn" + "Đơn vị phát hành" + "Trích yếu"
(phần "Trích yếu" sẽ được bỏ dấu - unicode).
Nhờ các bác chỉ giúp!
Em lót dép chờ hướng dẫn từ các bác...

 

[dhn46]

Bạn tham khảo bài #2 topic sau
http://www.giaiphapexcel.com/forum/showthread.php?99817-Đi-tìm-giải-pháp-cho-tìm-kiếm-và-rename-!

 

[ndu96081631]

Gởi các bác
Em co 1 file tổng hợp (gọi là master file), trong đó ghi các thông tin cơ bản và dùng hyperlink để link đến file trong cùng thư mục. Tuy nhiên sau 1 thời gian khá dài, hiện nay file này đã có hơn 6.000 dòng và sẽ tiếp tục dài thêm theo thời gian. Em thấy như vậy sẽ không ổn về lâu dài. (file đính kèm)
Giờ em muốn chuyển cách lưu trữ mới bằng cách đổi toàn bộ tên file (docxxx.pdf) thành các file tương ứng có dạng như sau: yymmdd + "Dự án" + "Số công văn" + "Đơn vị phát hành" + "Trích yếu"
(phần "Trích yếu" sẽ được bỏ dấu - unicode).
Nhờ các bác chỉ giúp!
Em lót dép chờ hướng dẫn từ các bác...

Hỏi lại:
- yymmdd lấy ở cột nào? Cột D chăng?
- Theo như quy ước bạn nêu ở trên, file ở G5 sẽ được đổi thành: 010817-A-2700/QD-xxx-Cty A-Cho phep tien hanh chuan bi dau tu.pdf
Đúng không?

 

[nokia6230ivn]

Đúng đó bác, cột D sẽ phải chuyển qua định dang yymmdd.

 

[ndu96081631]

Đúng đó bác, cột D sẽ phải chuyển qua định dang yymmdd.

Code sơ qua thế này xem:

Sub Main()
  Dim rng As Range, cel As Range
  Dim FSO As Object
  Dim oldFile As String, newFile As String, folder As String
  Set rng = Sheets("Cong van Di-Den").Range("G5:G10000")
  ReDim aDes(1 To rng.Rows.Count, 1 To 1)
  Set FSO = CreateObject("Scripting.FileSystemObject")
  For Each cel In rng
    If cel.Hyperlinks.Count Then
      oldFile = cel.Hyperlinks(1).Address
      If FSO.FileExists(oldFile) Then
        folder = FSO.GetFile(oldFile).ParentFolder.Path
        newFile = Format(cel.Offset(, -3).Value, "yymmdd") & "-" & _
                  cel.Offset(, -2).Value & "-" & _
                  cel.Offset(, -4).Value & "-" & _
                  cel.Offset(, 1).Value & "-" & _
                  RemoveMarks(cel.Offset(, -1).Value) & ".pdf"
        newFile = FSO.BuildPath(folder, newFile)
        If Not FSO.FileExists(newFile) Then FSO.MoveFile oldFile, newFile
      End If
    End If
  Next
End Sub
Function RemoveMarks(ByVal Text As String) As String
  Dim CharCode, i As Long
  Dim ResText As String, sTmp As String
  On Error Resume Next
  sTmp = Text
  CharCode = Array(7855, 7857, 7859, 7861, 7863, 7845, 7847, 7849, 7851, 7853, 225, _
                   224, 7843, 227, 7841, 259, 226, 273, 7871, 7873, 7875, 7877, 7879, _
                   233, 232, 7867, 7869, 7865, 234, 237, 236, 7881, 297, 7883, 7889, _
                   7891, 7893, 7895, 7897, 7899, 7901, 7903, 7905, 7907, 243, 242, _
                   7887, 245, 7885, 244, 417, 7913, 7915, 7917, 7919, 7921, 250, _
                   249, 7911, 361, 7909, 432, 253, 7923, 7927, 7929, 7925)
  ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
  For i = 0 To UBound(CharCode)
    sTmp = Replace(sTmp, ChrW(CharCode(i)), Mid(ResText, i + 1, 1))
    sTmp = Replace(sTmp, UCase(ChrW(CharCode(i))), UCase(Mid(ResText, i + 1, 1)))
  Next
  RemoveMarks = sTmp
End Function

 

[nokia6230ivn]

Cảm ơn bác, khổ nổi em không biết chút gì về VBA!
Đành phải ngâm cứu từ đầu... Hic...

 

[nokia6230ivn]

Bác ndu ơi, sao em mở VBA, copy đoạn mã trên rồi nhạy mà ko thấy gì xảy ra hết...
(Mở excel, nhấn tổ hợp Alt+F11, copy n past).

 

[ndu96081631]

Bác ndu ơi, sao em mở VBA, copy đoạn mã trên rồi nhạy mà ko thấy gì xảy ra hết...
(Mở excel, nhấn tổ hợp Alt+F11, copy n past).

Chỉ copy vào thôi thì đương nhiên chẳng có gì xảy ra rồi
- Từ bảng tính Excel, bạn bấm Alt + F11 để vào cửa sổ VBA
- Trong cửa sổ VBA, vào menu Insert, chọn Module (để chèn 1 module)
- Copy code rồi paste vào khung bên phải (của module vừa tạo)
- Bấm Alt + Q để trở về bảng tính
- Bấm Alt + F8, chọn Sub Main và Run

 

[nokia6230ivn]

Nhấn RUN rồi mà vẫn không thấy gì xãy ra hết bác ơi...

 

[ndu96081631]

Nhấn RUN rồi mà vẫn không thấy gì xãy ra hết bác ơi...

Mười mấy ngày test code? (lâu nhỉ) giờ mới thấy RUN không có gì xãy ra? Ai biết sao mà trả lời

 

[nokia6230ivn]

Biết làm sao được hả bác, em ko biết tí gì về VBA...

 

[nokia6230ivn]

Em đã tham khảo bài này http://www.giaiphapexcel.com/forum/showthread.php?99817-Đi-tìm-giải-pháp-cho-tìm-kiếm-và-rename- của bác dhn46 và có kết quả tốt.
Có điều vẫn đang vướng 1 chút ,nhờ các bác hỗ trợ thêm:
Vấn đề là khi chuyển các cột để ghép thành tên file thì vẫn còn 1 số ký tự thuộc dang đặc biệt như: "/", ":"... không thể rename được. Nhờ các bác chỉ chiêu để chuyển hết các ký tự này với...

 

[nokia6230ivn]

Bác cứ giỡn em...
Hiện nay em đang làm thủ công là past value, Ctr+H để thay thế các ký tự này trước khi raname. Cách nay cũng tạm được nhưng nó "nông dân quá". Em thử áp dụng công thức Find và Search nhưng ko được vì nó chỉ tìm được 1 chữ trong chuổi. Nếu chuổi có 2 - 3 ký tự thì ko biết xử lý thế nào...
Nhờ bác chỉ giáo giúp...