2017-02-15 115 views
1

我的問題是如何獲取特定Word文檔的作者姓名。獲取Word文檔的作者,VBA

我的功能是:

Public Function GetFileOwner(pFile As String) As String 

GetFileOwner = pFile.Owner 

End Function 

我來到這裏經過,我已經嘗試過.BuiltInDocmementProperties.約100文件,但這實在太慢......

也Shell.Application功能不爲我工作,因爲這隻適用於文件夾中的所有文件,但我需要它爲特定的文件..

有人知道另一個更快的解決方案嗎?還有一種PDF文件的方式嗎?

+0

你能不能也請發佈你已經嘗試過的'.BuiltInDocmementProperties'和'Shell.Application'的代碼,以及輸出或錯誤。如果你也想得到一個PDF的答案,IMO更好地將它添加到標題,並且都添加到標籤。 – omegastripes

回答

0

您可以在.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();

此DLL可以依次從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與測試。