Получить файл Автор документа Word, VBA

Question

мой вопрос: как получить имя автора определенного документа Word.

Моя функция:

Public Function GetFileOwner(pFile As String) As String 

GetFileOwner = pFile.Owner 

End Function 

я получаю здесь около 100 документов через, я уже пытался .BuiltInDocmementProperties., но это было слишком медленно ...

также функция Shell.Application не работа для меня, потому что это работает только со всеми файлами в папке, но мне нужно это для определенных файлов.

Знает ли кто-нибудь другое более быстрое решение? И есть ли способ для PDF-документов?

Answer 1

Вы можете сделать это довольно легко в .NET, так что я написал небольшую библиотеку DLL с неуправляемыми экспорта:

using System; 
using System.IO; 
using System.Linq; 
using System.Runtime.InteropServices; 
using RGiesecke.DllExport; 
using System.IO.Compression; 
using System.Xml.Linq; 

namespace DocxProperties 
{ 
    public class DocxPropertyGetter 
    { 
     [DllExport(nameof(GetDocxProp), CallingConvention.StdCall)] 
     [return: MarshalAs(UnmanagedType.AnsiBStr)] 
     public static string GetDocxProp([MarshalAs(UnmanagedType.AnsiBStr)] string wordPath, [MarshalAs(UnmanagedType.AnsiBStr)] string propName) 
     { 
      try 
      { 
       using (var fileStream = File.Open(wordPath, FileMode.Open)) 
       using (var parentArchive = new ZipArchive(fileStream)) 
       { 
        return GetPropName(parentArchive, propName); 
       } 
      } 
      catch (Exception ex) 
      { 
       return ex.ToString(); 
      } 
     } 

     private static string GetPropName(ZipArchive parentArchive, string propName) 
     { 
      var core = parentArchive.Entries.FirstOrDefault(e => e.FullName == "docProps/core.xml"); 

      using (var coreStream = core.Open()) 
      { 
       var doc = XDocument.Load(coreStream); 

       foreach (var descendant in doc.Descendants()) 
       { 
        if (descendant.Name.LocalName.Equals(propName, StringComparison.InvariantCultureIgnoreCase)) 
        { 
         return descendant.Value; 
        } 
       } 
      } 

      return string.Empty; 
     } 

    } 
} 

код немного более многословным, чем это необходимо для того, чтобы избежать некоторых любопытных ошибок в RGiesecke.DllExport если я использовал .FirstOrDefault() или .GetEntry();

Эта библиотека может быть в свою очередь вызывается из VBA, как это:

Option Explicit 

#If Win64 Then 
    Private Declare PtrSafe Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long 
    Private Declare PtrSafe Function GetDocxProp Lib "DocxProperties64.dll" (ByVal wordPath As String, ByVal propName As String) As String 
#Else 
    Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long 
    Private Declare Function GetDocxProp Lib "DocxProperties64.dll" (ByVal wordPath As String, ByVal propName As String) As String 
#End If 

Sub TestAuthorName() 
    Dim dllPath As String 

    #If Win64 Then 
     dllPath = "DocxProperties64.dll" 
    #Else 
     dllPath = "DocxProperties32.dll" 
    #End If 

    Call LoadLibrary(dllPath) 

    Debug.Print GetDocxProp(ThisWorkbook.path & "\EmptyDoc.docx", "creator") 

End Sub 

Private Function LoadLibrary(dllName As String) As Long 
    Dim path As String 
    path = ThisWorkbook.path & "\" & dllName 
    LoadLibrary = LoadLibraryA(path) 
End Function 

Извините, если я получил Объявляет неправильно 32- ... У меня нет каких-либо 32 версии MS Office для проверки с ,