Quản lý nội dung thư mục bằng excel (2 người xem)

[thanhnhanubnd]

Tôi đang làm 1 1file Excel để liệt kê thông tin các tập tin ( Subject, Authour, Title, date...) có trong 1 thư mục tùy chọn nhưng hiện tại vẫn chưa thực hiện được.

Tôi đã sử dụng lệnh Dir trong Dos để thống kê, xuất thành file Excel nhưng chỉ lấy được thông tin về ngày, tên, dung lượng mà không lấy được các thông tin khác,.

Xin các cao thủ gắng giúp đở dùm, xin rất cám ơn!!!
Thân chào

thanhnhanubnd@yahoo.com.vn.

 

[voda]

Bạn thử dùng đoạn code sau:

Sub GetDoc_Properties()
Dim FolderName As String, wbName As String
Dim rw As Integer
On Error Resume Next
FolderName = "C:\Documents and Settings\user\My Documents"
wbName = Dir(FolderName & "\" & "*.xls")
Application.ScreenUpdating = False
rw = 9
While wbName <> ""
    If wbName <> "book1.xls" Then
        Workbooks.Open wbName
        With Workbooks("book1.xls").ActiveSheet
    .Cells(rw, 2).Value = wbName
    .Cells(rw, 3).Value = ActiveWorkbook.BuiltinDocumentProperties(2)
    .Cells(rw, 4).Value = ActiveWorkbook.BuiltinDocumentProperties(5)
    .Cells(rw, 5).Value = ActiveWorkbook.BuiltinDocumentProperties(11)
    .Cells(rw, 6).Value = ActiveWorkbook.BuiltinDocumentProperties(1)
    .Cells(rw, 7).Value = ActiveWorkbook.BuiltinDocumentProperties(3)
End With
     Workbooks(wbName).Close
         rw = rw + 1
     End If
        wbName = Dir
 Wend
Application.ScreenUpdating = True
End Sub

 

[thanhnhanubnd]

Đầu tiên, xin chân thành cám ơn bạn Voda!

Xin bạn hướng dẫn kỹ hơn dùm mình vì mình không biết VBA bạn à.

Gàng giúp mình nhé, chân thành cám ơn bạn nhiều.

 

[voda]

Bạn thử dùng file sau. Nhớ nhập đường dẫn vào ô E4.

 

[voda]

Các bạn dùng file này. Có điều chỉnh. Lấy thông tin mà không cần mở file.

 

[thanhnhanubnd]

Xin cám ơn bạn VODA

Xin bạn giúp dùm .

1. Minh muon lay (title, subject, authour, date...) là lấy của các tập tin *.xls mà mình liệt kê ở danh sách chứ không phải của file Getdocpro.
2. Sau khi lấy xong mình sắp xếp danh sách theo thứ tự ngày tháng tăng dần.
3. Tạo nhiều sheet có nội dung như trên để quản lý nhiều nội dung ở nhiều thư mục.
Xin chân thành cám ơn bạn.

 

[thanhnhanubnd]

Thân chào bạn VODA.

Thật cám ơn khi bạn đã nhiệt tình giúp đở mình.

Mình đã tạo 1 file Excel hoàn chỉnh với những nội dung yêu cầu,xin bạn xem lại và giúp đở lần nữa nhé!!!

Chân thành cám ơn bạn!!

 

[thanhnhanubnd]

Quãn lý nội dung thư mục bằn Excel ( gửi bạn VODA)

Thân chào bạn VODA.

Thật cám ơn khi bạn đã nhiệt tình giúp đở mình.

Mình đã tạo 1 file Excel hoàn chỉnh với những nội dung yêu cầu,xin bạn xem lại và giúp đở lần nữa nhé!!!

Chân thành cám ơn bạn!!

 

[voda]

-Mình gộp 2 bước thành 1 bước có được không? Nghĩa là chỉ còn 1 sheet cho ra kết quả cuối cùng. Làm thế này gọn hơn.
-Bạn có cần sort theo ngày tháng không?
Cho biết ý kiến nhé!

 

[thanhnhanubnd]

Vậy thì quá tốt rồi, sắp xếp dữ liệu theo ngày tháng Voda nhé !
- 1 sheet quản lý 1 loại hồ sơ.
Bạn tạo dùm mình 4 sheet nhé!
Thanks.

 

[thanhnhanubnd]

- Bạn gộp các bước thành 1 sheet quá hay rồi, để tối ưu bạn làm thêm 1 bước nữa nhé:
1. Tao 1 sheet tên Quản lý văn bản để quản lý 04 sheet còn laị ( Quyết định, công văn, tờ trình, hợp đồng).
2. Trong 04 sheet ngoài liệt kê, ta còn Hyperlink chúng với file nguồn.

Xin cám ơn, mong bạn giúp.

 

[mymichau]

Xin Thầy Voda giải thích giùm em đoạn code:
ActiveWorkbook.BuiltinDocumentProperties(11)

 

[voda]

Nguyên văn bởi mymichau
Xin Thầy Voda giải thích giùm em đoạn code:
ActiveWorkbook.BuiltinDocumentProperties(11)

Bạn thử chạy đoạn code sau:

Sub GetPro()
On Error Resume Next
rw = 1
Worksheets(1).Activate
For Each p In ActiveWorkbook.BuiltinDocumentProperties
    Cells(rw, 1).Value = p.Name
    Cells(rw, 2).Value = ActiveWorkbook.BuiltinDocumentProperties(rw)
    rw = rw + 1
Next
End Sub

 

[thanhnhanubnd]

Gửi VODA
- Các thông tin từ Properties do người soạn nhập vào để quản lý file word.
- Thông tin title nhập theo dạng ( mm dd) 03 06.

Thân chào

Cám ơn vì đã nhiệt tình giúp đở!!!

 

[voda]

Nguyên văn bởi thanhnhanubnd
Gửi VODA
- Các thông tin từ Properties do người soạn nhập vào để quản lý file word.
- Thông tin title nhập theo dạng ( mm dd) 03 06.

Đã làm xong phần chương trình. Bạn chạy thử xem. Lưu ý các điểm sau:
-Đặt tên file theo dạng: 02 05 tailieu1.(ngày ở trước)
-Nhập thông tin Title theo dạng: 04 07 08 ( ngày ở trước)
Góp ý thêm với bạn: khi post bài không nên nhờ một ai đó cụ thể, nên nhờ nhiều người . Vì như thế bạn sẽ nhận được nhiều sự giúp đỡ hơn.

Option Explicit
Sub GetDoc_Properties()
Dim FolderName As String, wbName As String
Dim rw As Integer
Dim lrow As Long, lrow2 As Long
Dim ObjWord As Object
Dim DoSubj As String, DoTit As String, DoAut As String
Dim sDate
On Error Resume Next
lrow = ActiveSheet.Range("B65000").End(xlUp).Row
ActiveSheet.Range("A9:G" & lrow + 9).ClearContents
FolderName = Cells(4, 5)
wbName = Dir(FolderName & "\" & "*.doc")
Application.ScreenUpdating = False
rw = 9
Set ObjWord = CreateObject("Word.Application")
While wbName <> ""
       With ObjWord
           .Visible = True
           .Documents.Open (FolderName & "\" & wbName)
                DoSubj = .ActiveDocument.BuiltinDocumentProperties(2)
                DoTit = .ActiveDocument.BuiltinDocumentProperties(1)
                DoAut = .ActiveDocument.BuiltinDocumentProperties(3)
           .Documents(wbName).Close
         End With
    Cells(rw, 1) = rw - 8
    Cells(rw, 2).Value = DateSerial(2008, Mid(wbName, 4, 2), Mid(wbName, 1, 2))
    Cells(rw, 3).Value = Mid(wbName, 7, Len(wbName) - 10)
    Cells(rw, 4).Value = DoSubj
    sDate = Split(DoTit, " ")
    Cells(rw, 6).Value = DateSerial(sDate(2), sDate(1), sDate(0))
    Cells(rw, 5).Value = DoAut
    Cells(rw, 7).Value = Cells(rw, 6).Value - Cells(rw, 2).Value
    rw = rw + 1
           wbName = Dir
Wend
      Cells(5, 5) = rw - 9
      ObjWord.Quit
      lrow2 = Range("B65000").End(xlUp).Row
       Range("B9:H" & lrow2).Select
      Selection.Sort Key1:=Range("B9"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 Cells(1, 1).Select
If rw = 9 Then
     MsgBox "Duong dan hoac tap tin khong ton tai ", , "Thong bao"
End If
Application.ScreenUpdating = True
End Sub

 

[thanhnhanubnd]

Rất tuyệt vời !
Cám ơn rất nhiều ! Mình xin hỏi thêm 1 chút nhé :Sau khi đã hoàn chỉnh mình có thể lập trình để Hyperlink những file Word đã được liệt kê với file nguồn; khi click vào file nào thì ta sẽ mở và xem được nội dung file Word đó.

 

[voda]

Yêu cầu này không phải lập trình. Bạn chỉ cần dùng chức năng Hyperlink có sẵn của excel.

 

[thanhnhanubnd]

Nếu mình sử dụng Hyperlink của Excel thì không thể làm tự động được vì :
- Chỉ có thể làm thủ công từng file Word, khi đường dẫn thay đổi thì đâu còn hiểu được nữa?

Ý mình là Khi liệt kê bằng "Getdocpro" thì bản thân các file đã liên kết với file nguồn, khi nào muốn đọc thông tin file nguồn thì nhấn vào là được.

 

[voda]

Bạn tìm và bổ sung code như sau:

    Cells(rw, 1) = rw - 8
    Cells(rw, 2).Value = DateSerial(2008, Mid(wbName, 4, 2), Mid(wbName, 1, 2))
    Cells(rw, 3).Value = Mid(wbName, 7, Len(wbName) - 10)
    [B]Cells(rw, 3).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=FolderName & "\" & wbName[/B]

 

[thanhnhanubnd]

Mình đã làm được rồi, cám ơn bạn thật nhiều.