Tự động lấy tên Authors trên file properties của trong 1 folder vào Excel

[hoanhnnc]

Các sư huynh cho hỏi chút.

Tôi muốn Tự động lấy tên Authors trên file properties của trong 1 folder vào Excel.

Nhờ các anh chi giúp đỡ.


Thanks,

 

[Quang_Hải]

Các sư huynh cho hỏi chút.

Tôi muốn Tự động lấy tên Authors trên file properties của trong 1 folder vào Excel.

Nhờ các anh chi giúp đỡ.


Thanks,

Chỉ thế này

Sub GetAuthorDetail()
MsgBox ActiveWorkbook.BuiltinDocumentProperties("Author").Value
End Sub

 

[Hau151978]

Cách của bác QuangHai hình như chỉ lấy thông tin của file excel thôi. Để lấy thông tin của file bất kỳ, bạn vào Tools - Reference, bấm browse, chọn shell32.dll trong system32.
Copy đoạn code này vào module:

Function GetAuthorName$(ByVal FileName$)
    Dim shl As Shell32.Shell, fld As Shell32.Folder, fli As Shell32.FolderItem
    Set shl = New Shell32.Shell
    Set fld = shl.Namespace(ThisWorkbook.Path)
    Set fli = fld.ParseName(FileName)
    GetAuthorName = fld.GetDetailsOf(fli, 9)
    Set fli = Nothing
    Set fld = Nothing
    Set shl = Nothing
End Function
Sub Test()
MsgBox GetAuthorName("test.txt")
End Sub

 

[ndu96081631]

Cách của bác QuangHai hình như chỉ lấy thông tin của file excel thôi. Để lấy thông tin của file bất kỳ, bạn vào Tools - Reference, bấm browse, chọn shell32.dll trong system32.
Copy đoạn code này vào module:

Function GetAuthorName$(ByVal FileName$)
    Dim shl As Shell32.Shell, fld As Shell32.Folder, fli As Shell32.FolderItem
    Set shl = New Shell32.Shell
    Set fld = shl.Namespace([COLOR=#0000cd]ThisWorkbook.Path[/COLOR])
    Set fli = fld.ParseName(FileName)
    GetAuthorName = fld.GetDetailsOf(fli, [COLOR=#ff0000]9[/COLOR])
    Set fli = Nothing
    Set fld = Nothing
    Set shl = Nothing
End Function
Sub Test()
MsgBox GetAuthorName("test.txt")
End Sub

Đã nói là FILE BẤT KỲ mà sao có ThisWorkbook.path ở đây nhỉ?
Ngoài ra, tôi cảm thấy nghi ngờ con số 9 màu đỏ quá

 

[Hau151978]

Đã nói là FILE BẤT KỲ mà sao có ThisWorkbook.path ở đây nhỉ?
Ngoài ra, tôi cảm thấy nghi ngờ con số 9 màu đỏ quá

File bất kỳ thì cũng phải có Path chứ, function lấy thuộc tính của file cùng folder, nếu khác folder thì thay ThisWorkbook.Path thành đường dẫn.

 

[ndu96081631]

File bất kỳ thì cũng phải có Path chứ, function lấy thuộc tính của file cùng folder, nếu khác folder thì thay ThisWorkbook.Path thành đường dẫn.

Điều này có nghĩa là: Function của bạn thiếu tính tổng quát
Cái Thisworkbook.Path bạn cho vào Sub Test còn được chứ cho vào Function thì...
Ý tôi muốn nói là vậy đấy!
--------------------------------
Còn đây là code của tôi:

Function FileInfo(ByVal FilePath As String, ByVal Index As Long)
  Dim strFolder As String, strFile As String
  Dim shl As Object
  'Application.Volatile
  Set shl = CreateObject("Shell.Application")
  Dim lPos As String
  lPos = InStrRev(FilePath, "\")
  strFolder = Left(FilePath, lPos)
  strFile = Mid(FilePath, lPos + 1)
  With shl.Namespace("" & strFolder & "")
    FileInfo = .GetDetailsOf(.ParseName(strFile), Index)
  End With
End Function
Sub Test()
  Dim vFile As Variant, arr(286, 1 To 1)
  Dim n As Long, strPath As String
  vFile = Application.GetOpenFilename("All Files, *.*")
  If TypeName(vFile) = "String" Then
    strPath = CStr(vFile)
    Cells(1, "E") = strPath
    For n = 0 To 286
      arr(n, 1) = FileInfo(strPath, n)
    Next
    Range("C2").Resize(n).Value = arr
  End If
End Sub

Mời xem file để biết Authors tương đương với con số Index = bao nhiêu?
Hàm FileInfo này còn lấy được nhiều thứ khác chứ không riêng gì Authors

 

[hoanhnnc]

Thành thật cảm ơn
thầy ndu96081631

Giả sử em muốn lấy toàn bộ tên author của các file trong 1 folder và liệt kê vào sheet thì sao ạ? Xin chỉ giáo

Thanks,

 

[ndu96081631]

Thành thật cảm ơn
thầy ndu96081631

Giả sử em muốn lấy toàn bộ tên author của các file trong 1 folder và liệt kê vào sheet thì sao ạ? Xin chỉ giáo

Thanks,

Hàm FileInfo đã có, giờ bạn chỉ cần thêm hàm LẤY TÊN FILE TRONG FOLDER thôi, mà thứ này thì diễn đàn có cả đống
Tự nghiên cứu thử xem

 

[Quang_Hải]

Điều này có nghĩa là: Function của bạn thiếu tính tổng quát
Cái Thisworkbook.Path bạn cho vào Sub Test còn được chứ cho vào Function thì...
Ý tôi muốn nói là vậy đấy!
--------------------------------
Còn đây là code của tôi:

Function FileInfo(ByVal FilePath As String, ByVal Index As Long)
  Dim strFolder As String, strFile As String
  Dim shl As Object
  'Application.Volatile
  Set shl = CreateObject("Shell.Application")
  Dim lPos As String
  lPos = InStrRev(FilePath, "\")
  strFolder = Left(FilePath, lPos)
  strFile = Mid(FilePath, lPos + 1)
  With shl.Namespace("" & strFolder & "")
    FileInfo = .GetDetailsOf(.ParseName(strFile), Index)
  End With
End Function
Sub Test()
  Dim vFile As Variant, arr(286, 1 To 1)
  Dim n As Long, strPath As String
  vFile = Application.GetOpenFilename("All Files, *.*")
  If TypeName(vFile) = "String" Then
    strPath = CStr(vFile)
    Cells(1, "E") = strPath
    For n = 0 To 286
      arr(n, 1) = FileInfo(strPath, n)
    Next
    Range("C2").Resize(n).Value = arr
  End If
End Sub

Mời xem file để biết Authors tương đương với con số Index = bao nhiêu?
Hàm FileInfo này còn lấy được nhiều thứ khác chứ không riêng gì Authors

Hình như là code chỉ lấy thông tin Author của file có đuôi là xls thôi anh ơi.

 

[ndu96081631]

Hình như là code chỉ lấy thông tin Author của file có đuôi là xls thôi anh ơi.

Không biết nữa, nhưng test trên máy tôi thì nó lấy tuốt. File loại nào cũng được, chỉ yêu cầu file đó thật sự có thuộc tính Author (bởi không phải file nào cũng có thuộc tính này)
Nhược điểm của hàm FileInfo là nó không tự lấy được thuộc tính Author cũng chính nó

 

[hoanhnnc]

Chào thầy,

Sao khi chay phiên bản 2003 thi index không phải 20 mà là 9.

Vậy khi chỉnh index thành 9 mới chạy

Vậy tiện hỏi thầy
Lấy ngày date created vậy thì chỉnh đoạn code sao ạ.

Thanks,

 

[hoanhnnc]

http://www.giaiphapexcel.com/forum/member.php?134916-quanghai1969

Ở đây là lấy tất cac3 các loại file Mr. quanghai1969

 

[Quang_Hải]

Chào thầy,

Sao khi chay phiên bản 2003 thi index không phải 20 mà là 9.

Vậy khi chỉnh index thành 9 mới chạy

Vậy tiện hỏi thầy
Lấy ngày date created vậy thì chỉnh đoạn code sao ạ.

Thanks,

Đây là 1 lựa chọn khác. Hơi lu xu bu chút nhưng dễ dùng.
Ủa mà bài viết số 12 là ý gì vậy? Mình vốn không thích ai gọi mình là Mr, Bác, Thầy

Sub GetAuthor()
Dim file As Object, fso As Object, tam As String
Set fso = CreateObject("scripting.filesystemobject")
With fso.Getfolder(ThisWorkbook.Path)
   For Each file In .Files
      If file.Name <> ThisWorkbook.Name Then
         If Left(file.Name, 1) <> "~" Then
            With Workbooks.Open(file)
               tam = "FileName: " & file.Name _
               & vbLf & "Author: " & .BuiltinDocumentProperties(3).Value _
               & vbLf & "DateCreated: " & file.DateCreated
               MsgBox tam
               .Close False
            End With
         End If
      End If
   Next
End With
End Sub

 

[anh79_ct]

Điều này có nghĩa là: Function của bạn thiếu tính tổng quát
Cái Thisworkbook.Path bạn cho vào Sub Test còn được chứ cho vào Function thì...
Ý tôi muốn nói là vậy đấy!
--------------------------------
Em chào thầy,

Với macro này, em chỉ muốn lấy 3 thuộc tính là: "date modified", "Date created" và "date created" thì đã chỉnh code ở : "
For n = 0 To 286 (điều chỉnh thành 3 to 5). Nhưng em không muốn hiểu thị giờ thì làm thế nào?
Ngoài ra, em xác định đường dẫn file ở ô E1 trước luôn, chỉ cần nhấn nút lệnh là lấy được 3 thuôc tính ở trên, không cần hiển thị cửa sổ chọn file thì chỉnh code ở đâu?

Em cám ơn thầy!