Quản lý nội dung thư mục, liệt kê chọn lọc bằng Excel (1 người xem)

Người dùng đang xem chủ đề này

thanhnhanubnd

Thành viên hoạt động
Tham gia
12/9/08
Bài viết
180
Được thích
29
Nghề nghiệp
Xay dung
Xin chào các bạn, vừa qua tôi được sự giúp đở của bạn Voda nay đã thực hiện được việc quản lý thư mục bằng Excel.

Tôi là thành viên mới của GPE nên có nhiều bở ngở và kiến thức Excel còn ít, việc bạn Voda nhiệt tình giúp đở đó là nghĩa cử rất cao đẹp, xin chân thành cám ơn bạn.

Hôm nay, tôi chợt nghĩ ra 1 ý trong việc quản lý thư mục bằng Excel, ta không chỉ liệt kê tất cả theo hướng dẫn của bạn Voda mà còn chọn lọc dữ liệu liệt kê theo ý mình.

Mình đã làm 1 file Excel với những yêu cầu, mong các bạn xem và chỉ giúp.

Chân thành cám ơn, xin chào !!!
 

File đính kèm

Mình đã thử kết hợp với file Sealand 4 của bạn Sealandnhưng không được, các bạn giúp với.


Tập tin đính kèm
xls.gif
sealand4.xls (30.5 KB, 1 lần tải)
 
Lần chỉnh sửa cuối:
Mình gửi lại bạn kiểm tra xem đúng chưa? (Bạn lưu ý định dạng ngayd tháng phải đồng nhất)
 

File đính kèm

Lần chỉnh sửa cuối:
Mình thử rồi, rỏ ràng việc nhập dữ liệu vào các ô của mình không hay.

Nhờ bạn sử dụng lại file mình gửi, ở sheet quyet dinh .

Tạo dùng mình 4 nút bấm asign với 4 Macro có thể liệt kê theo 4 kiểu :

- Theo nội dung tên văn bản ( cột C).
- Theo ngày bất kỳ( Cột B)
- Theo Tháng bất kỳ ( Cột B)
- Theo tên người ký ( cột D).

Việc nhập dữ liệu để trích thì làm như bạn làm khi trích tên, cách này hay hơn cách nhập tên hay dữ liệu vào 1 ô nào đó.

Chào bạn!!
 
Mình sửa lại theo ý bạn có vấn đề gì báo lại nhé.
 

File đính kèm

Mình đang có vấn đề xin hướng dẫn :

Mình thử tạo 1 thư mục Test với khoảng 3000 file Word,mỗi file khoảng 20K, Tổng dung lượng khoảng 58MB.

Khi liệt kê bằng Getdoc_Pro thì mình mất khoảng 5 phút, xin hỏi có cách nào liệt kê nhanh hơn không. (Mình nghĩ là chậm do phải mở Word rồi đóng lại, có thể chỉ lấy tên mà không cần mở Word để cải thiện tốc độ).

Xin cám ơn!!!
 
Mình chưa xem được cụ thể cách làm của bạn, nhưng nếu chỉ lấy thông tin của file mà phải mở ra rồi đóng lại từng tập tin là không cần thiết. Bạn hoàn toàn có được thông tin qua đối tượng Scripting.FileSystemObject, bao gồm:
-Tên file
-Ngày lập.
-Ngày sửa cuối.
-Kích thước.
-Thư muc,ổ đĩa, đường dẫn...
-Ghi chú...
-User tạo file...
Trước đây tôi đã làm để tìm mở file, lấy dữ liệu rất nhanh (Nó không cần phải mở các file cần quản lý)
 
Lần chỉnh sửa cuối:
Mình không biết VBA, xin gửi Bạn code của bạn Voda :

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

* Mục đích :
1. Liệt kê tên tất cả file Word có trong 1 đường dẫn bất kỳ ( dạng : ngày tháng tên văn bản; ví dụ : 02 03 Hop dong 1.doc).
2. Tách 04 ký tự đầu sang dạng ngày/tháng/năm để được thời gian tạo.
3. Lấy các thông tin Title, Object, Author của văn bản.
4. Sắp xếp văn bản dạng tăng theo ngày.

* Nếu bỏ dòng lệnnh :

"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
Thì sẽ không lấy được Title, Object, Author.. còn nếu để lại thì chạy quán chậm.
 
Lần chỉnh sửa cuối:
Đúng rồi, câu lệnh active nó yêu cầu phải kích hoat tệp tin lên do vậy nó khá lâu. Còn Scripting.FileSystemObject nó không mở file thì có thể nó nhanh hơn. Mặt khác Scripting.FileSystemObject còn có thể chỉnh sửa ghi chú đổi tên file, sao chép di chuyển file.
Nếu không làm được thì mình sẽ gửi tài liệu hướng dẫn sau
(Nói thực mình là Kế toán trưởng vừa chuyển đơn vị nên bàn giao lu bù bạn ạ)
 
Thú thật là mình bó tay, vì mình không biết VBA, Scripting.FileSystemObject cũng không biết luôn, bạn tranh thủ giúp dùm nhé.

Cám ơn nhiều.

Các bạn ơi giúp với, ngày mai diễn đàn tạm ngưng rồi!!!

 
Lần chỉnh sửa cuối:
Để nhanh bạn cho biết nội dung các cột lấy từ thông tin nào của file, như vâyj đỡ phải mổ xẻ code mà bạn chuyển cho (Nếu không kịp mình sẽ chuyển qua Email)
 
Mình gừi file yêu cầu, mong các bạn xem và giúp dùm.
 

File đính kèm

Nguyên văn bởi thanhnhanubnd
Mình thử tạo 1 thư mục Test với khoảng 3000 file Word,mỗi file khoảng 20K, Tổng dung lượng khoảng 58MB.
Khi liệt kê bằng Getdoc_Pro thì mình mất khoảng 5 phút, xin hỏi có cách nào liệt kê nhanh hơn không. (Mình nghĩ là chậm do phải mở Word rồi đóng lại, có thể chỉ lấy tên mà không cần mở Word để cải thiện tốc độ).
-Vấn đề tốc độ của excel quả thật là nan giải. Phải chăng đây là hạn chế của "công cụ tuyệt vời" của chúng ta! May mà bạn mới test với 3000 file. Nếu nhiều hơn nữa thì sao? Có lẽ phải biết chấp nhận những giới hạn.
-Mình đã thử dùng Scripting.FileSystemObject, duyệt file rất nhanh, nhưng không cho thông tin về Title, Author, Subject của file doc.
-Có lẽ sau đây cũng là một giải pháp:
-Bạn chép file dsofile.dll vào máy.
-Mở chương trình GetdocPro_dll.
-Bấm Alt+F11 để vào cửa sổ code.
-Vào Tools/References. Bấm Browse tìm đến file dsofile.dll chọn và bấm Open.
-Trong cửa sổ References sẽ có thêm dòng DS: OLE Document Properties 1.4 Object Library. Bạn đánh dấu chọn vào trước đó - OK đóng hộp thoại.
-chạy thử chương trình.
-Mình đã thử vơi 3000 file mất khoảng 20 - 25 giây.
Mã:
Private oFilePropReader As DSOleFile.PropertyReader
Private oDocProp As DSOleFile.DocumentProperties
Sub GetDoc_Properties()
Dim oCustProp As DSOleFile.CustomProperty
  Set oFilePropReader = New DSOleFile.PropertyReader
  Dim DoSubj As String, DoTit As String, DoAut As String
Dim FolderName As String, wbName As String
Dim rw As Integer
Dim lrow As Long, lrow2 As Long
Dim sDate
On Error Resume Next
lrow = ActiveSheet.Range("A65000").End(xlUp).Row
ActiveSheet.Range("A9:G" & lrow + 9).ClearContents
FolderName = Cells(4, 5)
wbName = Dir(FolderName & "\" & "*.doc")
Application.ScreenUpdating = False
rw = 9
While wbName <> ""
        sFile = FolderName & "\" & wbName
        Set oDocProp = oFilePropReader.GetDocumentProperties(sFile)
                 DoSubj = oDocProp.Subject
                DoTit = oDocProp.Title
                DoAut = oDocProp.Author
    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
      lrow2 = Range("B65000").End(xlUp).Row
       Range("B9:H" & lrow2).Select
       Selection.Sort Key1:=Range("B9"), Order1:=xlDescending, 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
Nếu các bạn muốn test cho vui, hãy dùng code dưới đây để tạo 3000 file doc trong C:\New_Folder:
Mã:
Option Explicit
Sub taoFileDoc()
Dim i As Long
Dim wordAppl As Object
Set wordAppl = CreateObject("Word.Application")
Application.ScreenUpdating = False
 If Dir("C:\New_Folder", vbDirectory) = "" Then MkDir ("C:\New_Folder")
With wordAppl
For i = 1 To 3000
 .Documents.Add
 .ActiveDocument.BuiltinDocumentProperties(1) = "02 03 2008"
 .ActiveDocument.BuiltinDocumentProperties(2) = "han"
 .ActiveDocument.BuiltinDocumentProperties(3) = "123"
 .ActiveDocument.SaveAs "C:\New_Folder\" & "30" & Space(1) & "01" & Space(1) & "tailieu" & i & ".doc"
.ActiveDocument.Close
Next
.Quit
End With
Application.ScreenUpdating = True
Set wordAppl = Nothing
End Sub
 

File đính kèm

Xin chào các bạn! Chúc mừng GPE đã hoạt động trở lại.

Nhờ sự giúp đở của các bạn ( đặc biệt là Voda và sealand) mình đã hiểu và làm được quản lý thư mục.

Giải pháp của voda thật hay và có hiệu quả, xin chỉ giúp :

1. File dsofile.dll có tác dụng gì vậy.
2. Có thể lập trình hay tạo 1 file bat nào đó cho Microsoft VBA tự động :
" -Vào Tools/References. Bấm Browse tìm đến file dsofile.dll chọn và bấm Open.
-Trong cửa sổ References sẽ có thêm dòng DS: OLE Document Properties 1.4 Object Library. Bạn đánh dấu chọn vào trước đó - OK đóng hộp thoại"


với mặc định là file dsofile.dll cùng chung thư mục với file Excel đang chạy.Xin cám ơn.
 
1. dsofile.dll là loại file thư viện liên kết động (Dynamic Link Library). Trong file chứa các thủ tục hay hàm hỗ trợ cho việc thực hiện một phần việc nào đó của chương trình. Để có thông tin đầy đủ, bạn đọc bài của bác Phan Tự Hướng theo đường dẫn sau: http://www.giaiphapexcel.com/forum/showthread.php?t=6815 hoặc tìm trên diễn đàn.
2.Dòng lệnh để đăng ký tự động file dll như sau:
-Shell "regsvr32 -s C:\dsofile.dll" hoặc
-ThisWorkbook.VBProject.References.AddFromFile "C:\dsofile.dll"
Nếu file cùng thư mục với file chương trình, ta thay đường dẫn bằng ThisWorkbook.Path
 
1. Khi gắn mã này vào Getdoc_pro cua ban thì nó sẽ nằm ở dòng nào, bạn trích dẫn dùm nhé!
Trích:
" 2.Dòng lệnh để đăng ký tự động file dll như sau:
-Shell "regsvr32 -s C:\dsofile.dll" hoặc
-ThisWorkbook.VBProject.References.AddFromFile "C:\dsofile.dll"
Nếu file cùng thư mục với file chương trình, ta thay đường dẫn bằng ThisWorkbook.Path"

2.Nhờ bạn viết dùm 1 đoạn mã với nội dung yêu cầu như sau :


Khi chạy macro sẽ tạo mới được 01 file Word, file word này sẽ được mặc định tạo lưu trong thư mục mà ta đã chọn (FolderName = Cells(4, 5)).

3. Xin hỏi thêm :

- Trong Getdoc_pro nếu ta chọn 1 đường dẫn mặc định thì sẽ thay đổi như thế nào.

- Có thể tạo 01 Macro dạng Browse... để lấy đường dẫn đưa vào ô FolderName = Cells(4, 5) mà không cần phải nhập thủ công.

4.Trong Getdoc_pro có cách nào khóa :

- Khoá Nội dung các hàng cột từ A1 : G8 chỉ cho thay đổi nội dung trong FolderName = Cells(4, 5)
- Khóa nút bấm cho Macro, làm thế nào để cố định nút này, (không thể xóa hay di chuyển, đổi tên...nói chung là lock)
 
Lần chỉnh sửa cuối:
Nguyên văn bởi thanhnhanubnd
1. Khi gắn mã này vào Getdoc_pro cua ban thì nó sẽ nằm ở dòng nào, bạn trích dẫn dùm nhé!Trích:
" 2.Dòng lệnh để đăng ký tự động file dll như sau:
-Shell "regsvr32 -s C:\dsofile.dll" hoặc
-ThisWorkbook.VBProject.References.AddFromFile "C:\dsofile.dll"
Nếu file cùng thư mục với file chương trình, ta thay đường dẫn bằng ThisWorkbook.Path"
2.Nhờ bạn viết dùm 1 đoạn mã với nội dung yêu cầu như sau :
Khi chạy macro sẽ tạo mới được 01 file Word, file word này sẽ được mặc định tạo lưu trong thư mục mà ta đã chọn (FolderName = Cells(4, 5)).
3. Xin hỏi thêm :
- Trong Getdoc_pro nếu ta chọn 1 đường dẫn mặc định thì sẽ thay đổi như thế nào.

- Có thể tạo 01 Macro dạng Browse... để lấy đường dẫn đưa vào ô FolderName = Cells(4, 5) mà không cần phải nhập thủ công.

4.Trong Getdoc_pro có cách nào khóa :
- Khoá Nội dung các hàng cột từ A1 : G8 chỉ cho thay đổi nội dung trong FolderName = Cells(4, 5)
- Khóa nút bấm cho Macro, làm thế nào để cố định nút này, (không thể xóa hay di chuyển, đổi tên...nói chung là lock)
Câu 1:
-Dòng lệnh này viết trong module và dùng sự kiện Workbook_Open để chạy nó. Tuy nhiên mình khuyên bạn nên làm thủ công. Vì việc đăng ký này chỉ cần làm 1 lần. Code thì chạy nhiều lần, những lần chạy sau sẽ gây lỗi. Cũng có thể giải quyết bằng cách code chạy xong lần đầu cho nó tự xóa. Làm thế file quá nặng nề ( vì vốn đã nhiều chương trình rồi)
Câu 2:
Bạn dùng code sau:
-Tên file là: MyFile.doc. (Bạn có thể đổi)
-File lưu cùng đường dẫn với file chương trình.
Mã:
Option Explicit
Sub taoFileDoc()
Dim i As Long
Dim wordAppl As Object
Set wordAppl = CreateObject("Word.Application")
Application.ScreenUpdating = False
With wordAppl
   .Documents.Add
   .ActiveDocument.SaveAs ThisWorkbook.Path & "\ " & " MyFile.doc"
  .ActiveDocument.Close
  .Quit
End With
Application.ScreenUpdating = True
Set wordAppl = Nothing
End Sub
Câu 3:
Mình đã làm cho bạn nút Browse chọn thư mục.
Câu 4:
Dùng chức năng Protection để khóa vùng.Trong hộp thoại Protect Sheet, bỏ chọn mục Edit objects. Các button trong vùng sẽ lock. Trong file đính kèm mình đã khóa cho bạn. Muốn chỉnh sửa, mở khóa không cần pw.
 

File đính kèm

Rat that cam on VODA , thấy tin của bạn rất vui, cám ơn bạn đã nhiệt tình giúp.
1. Rất cám ơn bạn.Thủ tìm cách tự động load dùm mình.Nếu tự động load thì sẽ rất hay.

2. Mình chưa thử nhưng mà ý mình là : sẽ tạo 1 file word lưu trong đường dẫn mặc định ( cell folder mình vừa quản lý), tên thì sẽ tuỳ ý

3.Nút Browse .. nếu nhần cancel thì sẽ báo lỗi.
( thay vì nhấn ok).

4. Mình chưa thử

Xin chân thành cam on.

4. Mai mình test thử

* Hỏi thêm :

5.G.etdoc_pro và lọc dữ liệu khoảnh 15 Macro, Mình tạo thử menu "Quan ly van ban" gồm cácnút bấm asign các macro này, hỏi :

Lúc tạo menu bằng :tools/ customize thì ok, nhưng làm sao để tự động load menu và toolbar này khi file excel Getpro_doc mở ra (Mình coi diễn đản thử tạo *.Xla mà không được, có cần phải tạo sheet MENU không?? chỉ giúp, mình ko rành VBA);

6. Khi quản lý 4000 file dugn lương file khoảng 2MB, Khi copy thêm sheet thì sẽ lên 4,5... MB có cách nào giảm bớt dung lượng ko.
 
Lần chỉnh sửa cuối:
3.Nút Browse .. nếu nhần cancel thì sẽ báo lỗi.( thay vì nhấn ok).
Bạn tìm và chỉnh code như sau:
Mã:
Sub BrowserFolder()
  [B]On Error Resume Next[/B]
  With Application.FileDialog(4)
            .Title = "Chon thu muc"
            .Show
            Cells(4, 5) = .SelectedItems(1)
           End With
 End Sub
 
1. Bạn có thể viết 01 file *.bat nào đó để nó tự động load dsofile.dll không ( để màu mè 1 tý)

2. Xin nói rỏ Yêu cầu của Macro tạo file WORD :
- Khi chạy macro sẽ tạo ra 01 file word mới ( không cần lưu).
(Mình đã dùng Hyperlink nhưng nó hiển thị ra bảng thông báo trước khi liên kết- mình muốn bỏ qua bước này).

3. Nút Browse.. thật tuyệt vời.ok

4. Nếu " Dùng chức năng Protection để khóa vùng.Trong hộp thoại Protect Sheet, bỏ chọn mục Edit objects. Các button trong vùng sẽ lock. Trong file đính kèm mình đã khóa cho bạn. Muốn chỉnh sửa, mở khóa không cần pw"
thì sẽ bị lỗi, không chạy Macro được nữa.
 
Lần chỉnh sửa cuối:
1. File bat (đính kèm) phải đặt cùng thư mục với dsofile.dll. Kích chạy sẽ đăng ký dsofile.dll vào hệ thống.
2. Chưa rõ bạn tạo file word mới để làm gì?
4.Macro vẫn chạy, chỉ AutoFilter bị trở ngại thôi. Cách khắc phục: có lẽ dùng code để mở trước khi AutoFilter và khoá lại sau đó.
 

File đính kèm

1. Bạn xem lại giúp file này có lỗi rồi
( mình chép 3 file : getdoc, dso.bat, dsofile.dll vào cùng 1 thư mục. Mình gở bỏ việc đăng ký ( bằng thủ công) sau đó chay dso.bat để đăng ký nhưng không được. Chạy file Getdoc báo lỗi.

3. Mình đang có 1 vấn đề bị bí nhờ bạn chỉ giúp :

Hiện mình đã có 1 path ở 01 ô ( ví vụ : FolderName = Cells(4, 5))
Tạo 01 macro để thực hiện các yêu cầu theo các bước sau :
3.1. Tạo 1 file word.
3.2.Hiện lên bảng thông báo yêu càu nhập tên để lưu.
3.3. Sau khi nhập xong tên, hiện bảng thông báo yêu cầu nhập TITLE, Subject, Author.
3.4. File này sẽ lưu mặc định trong đường dẫn ở ô "FolderName = Cells(4, 5)".
3.5 Sau khi nhập thông tin xong ( bước 3.2; 3.3 ) thì mở file word đó ra.
( chú ý việc excel báo lỗi security; Macro này tác dụng : để mình tạo file word và nhập thông tin ngayhạy trong EXCEL).

4. Viết dùm đoạn code khóa thử nhé ( nhớ chừa lại ô mình ghi địa chỉ và ô ghi tổng số văn bản).
5. Thêm một vấn đề : Menu
Mình đã tạo được menu mới để chạy Macro và bỏ hết mấy menu chuẩn của chương trình.
Nay mình muốn viết macro cho việc In ấn ( print) và exit thì viết code thế nào.

Thank.
 
Lần chỉnh sửa cuối:
1. Kích hoạt dso.bat đăng ký dsofile.dll vào hệ thống, hộp thoại References hiện ra dòng DS:OLE Document...Cần phải làm một thao tác nữa là mở References đánh dấu chọn vào đó, chương trình mới chạy được. Muốn tự động hoàn toàn, bạn thử làm như sau:
a. Mở cửa sổ code của ThisWorkbook, chép code này vào:
Mã:
Private Sub Workbook_Open()
   Macro1
End Sub
b. Chép đoạn code sau vào module:
Mã:
Sub Macro1()
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromFile ThisWorkbook.Path & "\dsofile.dll"
End Sub
3.Đoạn code đó như sau:
Mã:
Option Explicit
Sub taoFileDoc()
Dim i As Long
Dim FolderName As String, TenFile As String, sTitle As String, sSubject As String, sAuthor As String
Dim wordAppl As Object
Set wordAppl = CreateObject("Word.Application")
Application.ScreenUpdating = False
FolderName = Cells(4, 5)
TenFile = InputBox("Nhap ten File")
sTitle = InputBox("Nhap Title")
sSubject = InputBox("Nhap Subject")
sAuthor = InputBox("Nhap Author")
With wordAppl
      .Documents.Add
      .ActiveDocument.BuiltinDocumentProperties(1) = sTitle
      .ActiveDocument.BuiltinDocumentProperties(2) = sSubject
      .ActiveDocument.BuiltinDocumentProperties(3) = sAuthor
      .ActiveDocument.SaveAs FolderName & TenFile & ".doc"
      .Visible = True
End With
Application.ScreenUpdating = True
Set wordAppl = Nothing
End Sub
4. Ở mỗi sub trong module 11 (trừ các sub loc_noidung, loc_nguoiky, loc_nguoilam, loc_nguoituvan), bổ sung 2 câu lệnh ở đầu và cuối. Ví dụ:
Mã:
Sub loc_thang()
[B]ActiveSheet.Unprotect "123"[/B]
Application.ScreenUpdating = False
thg = InputBox("Nhap thang can loc", "QUAN LY HO SO VAN BAN")
lrow = Cells(5, 5)
For I = 9 To lrow
Cells(I, 9) = Month(Cells(I, 2))
 Next
Set rngFind = Range("I9:I" & lrow).Find(thg)
               If rngFind Is Nothing Then
                       MsgBox "Khong co dulieu can loc", , "Thong Bao"
Exit Sub
End If
 show_All
 Range("A8").AutoFilter Field:=9, Criteria1:=thg
Range("I9:I" & lrow).ClearContents
Application.ScreenUpdating = True
[B]ActiveSheet.Protect "123"[/B]
End Sub
5. Macro hiện hộp thoại in:
Mã:
Sub Print_Show()
 Application.Dialogs(8).Show
End Sub
Macro đóng file:
Mã:
Sub DongFile()
  ActiveWorkbook.Save
  Application.Quit
End Sub
 

File đính kèm

1. Kích hoạt dso.bat đăng ký dsofile.dll vào hệ thống, hộp thoại References hiện ra dòng DS:OLE Document...Cần phải làm một thao tác nữa là mở References đánh dấu chọn vào đó, chương trình mới chạy được. Muốn tự động hoàn toàn, bạn thử làm như sau:
a. Mở cửa sổ code của ThisWorkbook, chép code này vào:
Code:
Private Sub Workbook_Open()
Macro1
End Sub
b. Chép đoạn code sau vào module:
Code:
Sub Macro1()
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromFile ThisWorkbook.Path & "\dsofile.dll"
End Sub


Có 1 lỗi thế này : khi chạy file đồng ý là tự động load.
- Nhấn Alt+F11 vào VB, Vào gở bỏ phần đánh dấu.
- Lưu lại.
- Lần sau chạy file : báo lỗi, không load được

3. Chạy đoạn code có 02 lổi sau :
- Máy treo hiện ra thông báo : "M excel waiting for another appication to complete OLE action" hiện bảng properties phải Alt+del để thoát.
- Lổi đặt tên :ví dụ mình đặt tên là "02 02 thu tao doc.doc" thì file tạo ra tên : "Test00202 thu tao doc.doc" nếu vậy thì mình đâu thể dùnf Getdoc_pro được.
* Nhờ khắc phục giúp HAY LÀ : Để thuận tiện thay vì tạo 04 hộp thoại bạn tạo dùm 1 hộp thoại (dạng form) nhưng vẫn có thể nhập 4 thông tin trên.

Thân chào.!
 
Lần chỉnh sửa cuối:
1. Bạn chép 3 file vào trong 1 thư mục trước. Kích đôi để chạy dso.bat (phải thấy nháy cửa sổ ). Mở file và chạy.
2.Bạn đặt tên file không cần đuôi doc. Tải file về chạy thử.
 

File đính kèm

File rất hay. Nhưng nếu có thư mục thì trong file Browse bạn cho mình phải thêm &"\"
 
Lần chỉnh sửa cuối:
Bạn vào cửa sổ code của userform chỉnh như sau:
.ActiveDocument.SaveAs FolderName & "\" & TenFile & ".doc"
 
Bảng form rất hay bạn hoàn thiện nó dùm :
1. Thêm nút command "cancel" ( vì nút close trên form nhỏ quá).
2. Nếu không nhập liệu trong form mà nhấn nút tạo ( mình thêm On Error Resume Next) thì không lỗi nhưng nó tạo file tên documnet. Ta tuỳ biến, nếu nhấn vào không có dữ liệu thì tự mất.
3. Sau khi nhập thông tin, không cần xuất hiện bảng properties của Word.
4. Sau khi nhâp thông tin thì form tự động mất ".close" ( hiện tại sau khi tạo file xong form trong excel vẫn còn).
 
sau khi bạn nhập thông tin xong nhấn "tạo" thì bảng properties hiện ra ( giống như xem lại thông tin vừa nhập).Bỏ qua hộp thoại này.
 
Bạn có thể mô tả bảng Properties đó được không? Của Excel hay Word?
 
1. Mình sửa code của bạn :
"Private Sub CommandButton1_Click()
UserForm1.Show
End Sub"

Thành :
"Sub CommandButton1_Click()
UserForm1.Show
End Sub"

để gắn vào menubar chạy Macro. Nó vẫn ngon lành chỉ bị 1 cái là sau khi nhập thông tin hiện lên bảng properties lên. (file của bạn không bị hiện tượng này).

2. Khi tạo file word mình muốn nhập thêm 01 thông tin nữa ( manager, category...) thì làm sao vậy?
 
Bạn tạo thêm 2 textbox trên form và bổ sung code như sau:
Mã:
Private Sub CommandButton1_Click()
On Error GoTo Boqua
Dim i As Long
Dim FolderName As String, TenFile As String, sTitle As String, sSubject As String, sAuthor As String
[B]Dim sCategory As String, sManager As String[/B]
Dim wordAppl As Object
Set wordAppl = CreateObject("Word.Application")
Application.ScreenUpdating = False
FolderName = Cells(4, 5)
TenFile = TextBox1.Text
sTitle = TextBox2.Text
sSubject = TextBox3.Text
sAuthor = TextBox4.Text
[B]sCategory = TextBox5.Text[/B]
[B]sManager = TextBox6.Text[/B]
With wordAppl
      .Documents.Add
      .ActiveDocument.BuiltinDocumentProperties(1) = sTitle
      .ActiveDocument.BuiltinDocumentProperties(2) = sSubject
      .ActiveDocument.BuiltinDocumentProperties(3) = sAuthor
      [B].ActiveDocument.BuiltinDocumentProperties(18) = sCategory[/B]
      [B].ActiveDocument.BuiltinDocumentProperties(20) = sManager[/B]
      .ActiveDocument.SaveAs FolderName & "\" & TenFile & ".doc"
      .Visible = True
End With
Application.ScreenUpdating = True
Boqua:
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
Set wordAppl = Nothing
UserForm1.Hide
End Sub
 
Khi tạo forms trên.
1. Bạn Làm dùm thông báo :Khi nhập text cho sManager, ta định dạng nội dung này là dd mm yy ; nếu khi nhập mà nhập text sai loại ( ví dụ "aaaaaa" hay "111111"...) thì hiện lên thông báo yêu cầu nhập lại.

2. Có code nào khi hiện form mình vẫn có thể kích hoạt các ô dữ liệu trong excel.
 
Lần chỉnh sửa cuối:
Bạn bổ sung vào code:
Mã:
If IsNumeric(TextBox6.Text) = True Or IsDate(TextBox6.Text) = False Then
MsgBox "Ban phai nhap Manager dang date (dd/mm/yy)", , "Thong Bao"
TextBox6.Text = ""
Exit Sub
End If
TextBox6.Text = DateSerial(Mid(TextBox6.Text, 7, 2), Mid(TextBox6.Text, 4, 2), Mid(TextBox6.Text, 1, 2))
TextBox6.Text = Format(TextBox6.Text, "dd/mm/yy")
 

File đính kèm

Nhờ bạn tạo dùm form sửa chữa Properties của word nhé ( file bị sửa đã đóng).
Thank.
 

File đính kèm

1.Các cao thủ ơi, giúp mình làm form với.
2. Bạn nào biết cách sử dụng : Multipage hay Tabstip trong form có cách nào chỉnh page1 lớn, page 2 kích thước nhỏ hơn không? ( vì chúng lúc nào cũng bằng nhau.
 
Lần chỉnh sửa cuối:
Nguyên văn bởi thanhnhanubnd
Nhờ bạn tạo dùm form sửa chữa Properties của word nhé ( file bị sửa đã đóng).
Bạn dùng code sau, chú ý một số điểm:
1. Cells(4,5) chứa đường dẫn đến thư mục.
2. Dữ liệu bắt đầu từ dòng 8.
3. Tên file ghi ở cột C
4. Nếu tên file thay đổi phải chạy lại thủ tục GetDoc_Pro, sheet mới cập nhật.
Code chứa trong sheet:
Mã:
Private Sub CommandButton1_Click()
With UserForm1
     .TextBox1.Text = ""
     .TextBox2.Text = ""
     .TextBox3.Text = ""
     .TextBox4.Text = ""
     .TextBox5.Text = ""
     .TextBox6.Text = ""
     .TextBox7.Text = ""
    .CommandButton2.Enabled = False
  End With
UserForm1.Show
End Sub
Code chứa trong Form:
Mã:
Private oFilePropReader As DSOleFile.PropertyReader
Private oDocProp As DSOleFile.DocumentProperties
Dim eFile As String, eFolderName As String
Private Sub CommandButton1_Click()
On Error Resume Next
Dim stt As Integer
Dim ewbName As String
Dim oCustProp As DSOleFile.CustomProperty
  Set oFilePropReader = New DSOleFile.PropertyReader
  eFolderName = Cells(4, 5)
  stt = TextBox1.Text
  ewbName = Cells(stt + 8, 3)
  eFile = eFolderName & "\" & ewbName
  Set oDocProp = oFilePropReader.GetDocumentProperties(eFile)
                   TextBox2.Text = oDocProp.Name
                   TextBox3.Text = oDocProp.Title
                   TextBox4.Text = oDocProp.Subject
                   TextBox5.Text = oDocProp.Author
                   TextBox6.Text = oDocProp.Category
                   TextBox7.Text = oDocProp.Manager
  CommandButton2.Enabled = True
   End Sub
Private Sub CommandButton2_Click()
On Error Resume Next
Dim oCustProp As DSOleFile.CustomProperty
  Name eFile As eFolderName & "\" & TextBox2.Text
                   oDocProp.Title = TextBox3.Text
                   oDocProp.Subject = TextBox4.Text
                   oDocProp.Author = TextBox5.Text
                   oDocProp.Category = TextBox6.Text
                   oDocProp.Manager = TextBox7.Text
                   TextBox2.Text = ""
                  TextBox3.Text = ""
                  TextBox4.Text = ""
                  TextBox5.Text = ""
                  TextBox6.Text = ""
                  TextBox7.Text = ""
  Set oDocProp = Nothing
End Sub
Private Sub CommandButton3_Click()
UserForm1.Hide
End Sub
 

File đính kèm

có 1 lỗi thế này :
1. Tại vì lúc Browse.. mình đã thêm & "\" nên tên file là đúng tên chứ không có \. Ví dụ : nhan.doc; chứ không phải \nhan.doc như file của VODA.
2. Khi chạy chương trình các properties thì ok. chỉ có tên là không sửa được.

* Có thể thống nhất cách này được ko bạn :
a. File liệt kê trong cột C sẽ không có doc. ( nhờ tác giả sửa Getdoc_pro dùm)- mà nếu có .doc thì lúc Edit propertis bạn mặc định *.doc dùm.

b. Trong code Browe sẽ thêm
& "\" ( sửa 1 chút nhé) - xin lổi tác giả mình thêm rồi.

c. file "toaword" sẽ không có & "\" - tại vì đã có trong Browse..

d.File edit tất nhiên sẽ hiện theo tên thật ( không có "\") và khi edit nó sẽ ok.

T( mọi thông tin chịu hết chỉ có tên là không chịu đổi)
 
Lần chỉnh sửa cuối:
-Tên file không đổi: mình sẽ chỉnh chỗ này.
-Bạn có thể lấy phần code tích hợp vào file đã thêm sửa.
-Nếu không được, gởi cho mình file đã chỉnh sửa để mình tích hợp code edit này vào.
 
OK bạn chỉ giúp mình đổi tên là được . Tên file là tên thật không có &"\"
 
Mình đã bổ sung:
-Thay đổi được tên file
-Cập nhật tên file sau khi đổi.
-Tên file hiển thị trong cột C và trong hộp thoại edit không có "\"
Bạn kiểm tra lại, có gì sẽ bổ sung tiếp.
 

File đính kèm

Bổ sung: lệnh xóa file.
 

File đính kèm

File chạy rất tốt.Mình xin hỏi 1 vấn đề thế này :

trong form mình có nhiều page 1,2,3.Trong page 2 của mình có 2 nút option và 1 số button click, textbox. Nay mình muốn disable toàn bộ button click, textbox chỉ chưà lại option thì làm cách nào.Nếu disable từng cái thì vẫn được nhưng dòng code dài quá.
 
- Bạn dùng vòng lặp duyệt và disable tất cả.
- Bạn làm thử. Nếu gặp khó khăn thì gởi file lên, sẽ có người giúp.
- Có thể mở topic mới.
 
Topic này có mỗi 2 bạn bàn bạc nhỉ :D. cho tớ góp vui.
Xin phép hỏi lại 1câu trong topic khác cũng có 2 bạn là làm sao để quản lý đc cả các file khác không chỉ là file .doc (chẳng hạn PDF, rar) với không chỉ tên tuổi ngày giờ mà còn cả các comment của file nhỉ??
Mình vẫn đang tìm hiểu cái này, nếu ai giúp đc thì tốt quá!
Tks in advance
 
Theo yêu cầu của bạn Thanh nhan mình bổ xung File quản lý thư mục
Tại file này bạn có thể thêm bao nhiêu sheet tùy ý và nên chia nhỏ các thư mục (Sheet) thì file đỡ nặng. Bạn kiểm tra có gì cho mình biết vì bổ xung dễ có sai sót.
 

File đính kèm

File của bạn thật đúng với ý mình, có 1 điều thế này :
1. Mình muốn option button luôn mặc định ở chế độ " không lọc"
2. Khi ở chế độ " không lọc" thì bạn enable nút "chọn hồ sơ dùm" mình.
Cám ơn nhiều.
 
Bạn thay dòng lệnh trong Sub sau:
Mã:
[COLOR=Blue]Private Sub UserForm_Activate()
......................................

Me.OptionButton[SIZE=4][B][COLOR=Red]2[/COLOR][/B][/SIZE] = True
.....................................
End Sub[/COLOR]
Bằng dòng lệnh sau:
Mã:
[COLOR=Blue]Private Sub UserForm_Activate()
......................................

Me.OptionButton[/COLOR][COLOR=Blue][B][SIZE=4][COLOR=Red]1[/COLOR][/SIZE][/B] = True
.....................................
End Sub[/COLOR]
Lưu ý: chỉ dòng đó còn các dòng khác để nguyên kể cả trật tự, vì nó liên quan đến trình tự nạp các đối tương. Combo chi tiết nếu không nhớ chính xác thì nhập 1 vài ký tự cần lọc và enter cũng được.
 
Lần chỉnh sửa cuối:
Hôm trước thấy cái code list toàn bộ file trong 1 thư mục, bao gồm cả thư mục con mà giờ tìm không thấy, bác nào có post lại với.
Yêu cầu là lấy toàn bộ file và đường dẫn đầy đủ để đưa vào cột A
Đường dẫn cần lấy cho vào biến trong Sub cũng được, thanks anh em
Đã viết rồi nhưng quên không ghi và đầu óc đang bận bịu nên anh em có thì post giùm với nhé
 
Hôm trước thấy cái code list toàn bộ file trong 1 thư mục, bao gồm cả thư mục con mà giờ tìm không thấy, bác nào có post lại với.
Yêu cầu là lấy toàn bộ file và đường dẫn đầy đủ để đưa vào cột A
Đường dẫn cần lấy cho vào biến trong Sub cũng được, thanks anh em
Đã viết rồi nhưng quên không ghi và đầu óc đang bận bịu nên anh em có thì post giùm với nhé
Dùng code này thử xem:
PHP:
Sub SeachFiles1()
  Dim i As Long, MyDir As String
  On Error GoTo Thoat
  With Application.FileDialog(4)
    .Show: MyDir = .SelectedItems(1)
  End With
  With Application.FileSearch
    .SearchSubFolders = True     '<--- Tim ca trong thu muc con
    .LookIn = MyDir 
    .Filename = "*.*"          '<--- Kieu file can tìm
    If .Execute() > 0 Then
      Range("A2:A65536").ClearContents
      For i = 1 To .FoundFiles.Count
        Cells(i + 1, 1) = .FoundFiles(i)
      Next i
    End If
    MsgBox .FoundFiles.Count & " files found."
  End With
Thoat:
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Mình chưa xem được cụ thể cách làm của bạn, nhưng nếu chỉ lấy thông tin của file mà phải mở ra rồi đóng lại từng tập tin là không cần thiết. Bạn hoàn toàn có được thông tin qua đối tượng Scripting.FileSystemObject, bao gồm:
-Tên file
-Ngày lập.
-Ngày sửa cuối.
-Kích thước.
-Thư muc,ổ đĩa, đường dẫn...
-Ghi chú...
-User tạo file...
Trước đây tôi đã làm để tìm mở file, lấy dữ liệu rất nhanh (Nó không cần phải mở các file cần quản lý)

Em đã đọc qua các bài trong topic này và topic Làm thế nào liệt kê danh mục folder trong 1 folder! nhưng chưa biết ứng dụng. Thật sự qua lúng túng do kiến thức hạn chế.

Có bài này của tác giả domfootwear tại đây và đã load file về thử. Code của Thầy ndu96081631
Cũng rất tiện nhưng chưa đáp ứng yêu cầu của em

Em có 1 yêu cầu nho nhỏ, kính nhờ Quý Thầy giúp cho code xử lý khi liệt kê các thư mục mẹ, thư mục con, thư mục cháu, tập tin bất kỳ trong ổ đĩa nào thì sẽ cho hiển thị theo tuần tự các cột và có cả đường link như sau :

|
A​
|
B​
|
C​
|
D​
|
E​
|
F​
|
G​
|
1​
|
Tên ổ đĩa​
|
Directory​
|
Sub Directory​
|
Tên file - có cả đường link​
|
Ngày lập​
|
Ngày sửa cuối​
|
Kích thước​
|

Chân thành cám ơn
 
Lần chỉnh sửa cuối:
Bác xem cách đơn giản nhất để liệt kê
 

File đính kèm

Lần chỉnh sửa cuối:
Em đã đọc qua các bài trong topic này và topic Làm thế nào liệt kê danh mục folder trong 1 folder! nhưng chưa biết ứng dụng. Thật sự qua lúng túng do kiến thức hạn chế.

Có bài này của tác giả domfootwear tại đây và đã load file về thử. Code của Thầy ndu96081631
Cũng rất tiện nhưng chưa đáp ứng yêu cầu của em

Em có 1 yêu cầu nho nhỏ, kính nhờ Quý Thầy giúp cho code xử lý khi liệt kê các thư mục mẹ, thư mục con, thư mục cháu, tập tin bất kỳ trong ổ đĩa nào thì sẽ cho hiển thị theo tuần tự các cột và có cả đường link như sau :

|
A​
|
B​
|
C​
|
D​
|
E​
|
F​
|
G​
|
1​
|
Tên ổ đĩa​
|
Directory​
|
Sub Directory​
|
Tên file - có cả đường link​
|
Ngày lập​
|
Ngày sửa cuối​
|
Kích thước​
|
Chân thành cám ơn

Viết theo yêu cầu của KTGG:
Chạy file ListFolder.xla, xuất hiện menu Ds tập tin có menu con Lập danh sách tập tin

Yêu cầu:

- Sheet tạo danh sách phải có tên Folder, Workbook này phải active.
- Sheet Folder đã có sẳn dòng tiêu đề

Các lựa chọn:
- Tạo danh sách mới: xóa danh sách đã có, tạo danh sách mới theo thư mục chọn.
- Chép nối danh sách: giữ nguyên danh sách đã có, tạo danh sách mới theo thư mục chọn và chép nối phía dưới. Có thể lập chung danh sách nhiều thư mục ở các ổ đĩa khác nhau.
- Cập nhật danh sách đã tạo: cập nhật lại danh sách các tập tin trong các thư mục đã có trong Directory
- Các loại tập tin trong danh sách: giới hạn các loại tập tin cần liệt kê. Nhập loại tập tin cần đưa vào danh sách, cách nhau 1 khoảng trắng. Nếu bỏ trống xem như chọn tất cả các tập tin.

ListFile01-1.jpg


Password các file xla của tôi là phamduylong
 

File đính kèm

Lần chỉnh sửa cuối:
Cám ơn Thầy Long đã tạo công cụ add-ins cho diễn đàn rất tuyệt. Rất dễ sử dụng và đúng ý của em nữa.
Xin phép cho em hỏi -
+ Nếu sử dụng office 2003 thì có hạn chế các tập tin khi kết xuất ra không ?
+ Thầy có thể vui lòng sửa code cho phép chọn tất cả các tập tin (*.*) thay vì chỉ có các loại tập tin xls và doc thôi. Có thể chọn loại tập tin kết xuất tùy ý cũng được

Đã được Thầy Long giải thích trong bài và qua điện thoại
- Các loại tập tin trong danh sách: giới hạn các loại tập tin cần liệt kê. Nhập loại tập tin cần đưa vào danh sách, cách nhau 1 khoảng trắng. Nếu bỏ trống xem như chọn tất cả các tập tin.

Kính
 
Lần chỉnh sửa cuối:
Cám ơn Thầy Long đã tạo công cụ add-ins cho diễn đàn rất tuyệt. Rất dễ sử dụng và đúng ý của em nữa.
Xin phép cho em hỏi -
+ Nếu sử dụng office 2003 thì có hạn chế các tập tin khi kết xuất ra không ?
+ Thầy có thể vui lòng sửa code cho phép chọn tất cả các tập tin (*.*) thay vì chỉ có các loại tập tin xls và doc thôi. Có thể chọn loại tập tin kết xuất tùy ý cũng được
Kính

- Excel 2003 chỉ có 65536 dòng, lưu được 65535 dữ liệu. Có thể phải chỉnh lại để nếu số dữ liệu nhiều hơn thì chép nối qua sheet khác.

- Chọn loại tập tin kết xuất tùy ý:
- Các loại tập tin trong danh sách: giới hạn các loại tập tin cần liệt kê. Nhập loại tập tin cần đưa vào danh sách, cách nhau 1 khoảng trắng. Nếu bỏ trống xem như chọn tất cả các tập tin.
 
Quá hay, xin cám ơn Thầy đã tạo một công cụ hữu ích
 
Thầy Long có thể chỉnh dùm e thêm thống kê file Cad được không đuôi của nó là(*.dwg)
(Hihi đã kt thống kê hầu hết tất cả các định dạng wa tuyệt.)
 
Lần chỉnh sửa cuối:
Chào mọi người,

Bài viết của bạn phamduylong rất hay. Cảm ơn bạn nhiều. Bạn có thể giúp mình thêm tí xíu nữa được không? Đó là thêm 1 cột Author và 1 cột Last Author nữa được không. Mình cũng đang cần file này gấp. Rất mong bạn và mọi người giúp đỡ. Thanks a lot.
 
Lần chỉnh sửa cuối:
Sao chẳng thấy ai trả lời giúp mình với.+-+-+-+
 
Chào mọi người,

Bài viết của bạn phamduylong rất hay. Cảm ơn bạn nhiều. Bạn có thể giúp mình thêm tí xíu nữa được không? Đó là thêm 1 cột Author và 1 cột Last Author nữa được không. Mình cũng đang cần file này gấp. Rất mong bạn và mọi người giúp đỡ. Thanks a lot.
Bạn xem tại đây.
http://www.giaiphapexcel.com/forum/...hạm-Duy-Long-vừa-tạ-thế-lúc-3-00AM-27-09-2010
Mọi người sẽ cố giúp bạn nhanh nhất có thể.
 
Buồn quá. Thế thì anh em nào khác có thể giúp mình vấn đề này ko?
 
bổ sung lệnh copy

Hi bác voda,
mình thấy file của bác làm rất hay, tuy nhiên mình có một yêu cầu mong bác giúp đỡ như sau. Bác thêm giúp mình 1 nut copy các file được chọn đến một thư mục định sẵn trong 1 cell.
Bổ sung: lệnh xóa file.
 
Hỏi về litsfolder của phạm duy long

Các bạn làm ơn cho mình hỏi: Trong File Dsach mình muốn thêm các cột có các thông tin Title, Subject, Author,... thì phải thêm Code như thế nào?
Chân thành cảm ơn!
 

Bài viết mới nhất

Back
Top Bottom