Zmiana właściwości pliku DSOFile.dll   strona główna:
A po co ten Excel ;-)
 
    DSOFile to niestandardowy component ActiveX dzięki któremu możemy zczytać lub zmienić (nie wszystkie) właściwości pliku.  
Można też tworzyć niestandardowe właściwości pliku.  
 
Co jest potrzebne:   The Dsofile.dll files lets you edit Office document properties when you do not have Office installed
    - Ze stron M$ trzeba pobrać i zainstalować DsoFileSetup_KB224351_x86.exe (link z prawej)  
    - w Edytorze VBA trzeba się upewnić czy na liście Referencji znajduje się: DSO OLE Document Properties Reader 2.1.  
      Jeżeli nie należy wskazać plik dsofile.dll. Będzie w miejscu które wskazaliśmy podczas instalacji.  
 
Zobaczmy więc czego możemy się o danym pliku dowiedzieć :-)  
 
Sub TestDSO()  
    On Error GoTo TestDSO_Error  
 
    Dim m_oDocument As Object 'DSOFile.OleDocumentProperties  
    Dim oSummProps As Object 'DSOFile.SummaryProperties  
 
    Const strFilePath As String = "C:\Documents and Settings\tkuchta1\Pulpit\zeszyt1.xls"  
 
    Set m_oDocument = VBA.CreateObject("DSOFile.OleDocumentProperties")  
    With m_oDocument  
        .Open strFilePath, False  
        If Not .IsReadOnly Then  
            Set oSummProps = .SummaryProperties  
            With oSummProps  
               
    MsgBox "Plik: " & strFilePath & vbNewLine & vbNewLine & _  
            "Application:  " & .ApplicationName & vbNewLine & _  
            "Version:      " & .Version & vbNewLine & _  
            "Subject:      " & .Subject & vbNewLine & _  
            "Category:     " & .Category & vbNewLine & _  
            "Company:      " & .Company & vbNewLine & _  
            "Keywords:     " & .Keywords & vbNewLine & _  
            "Manager:      " & .Manager & vbNewLine & _  
            "LastSaved by: " & .LastSavedBy & vbNewLine & _  
            "WordCount:    " & .WordCount & vbNewLine & _  
            "PageCount:    " & .PageCount & vbNewLine & _  
            "ParagraphCount: " & .ParagraphCount & vbNewLine & _  
            "LineCount:    " & .LineCount & vbNewLine & _  
            "CharacterCount: " & .CharacterCount & vbNewLine & _  
            "CharacterCount (w/spaces): " & .CharacterCountWithSpaces & vbNewLine & _  
            "ByteCount:    " & .ByteCount & vbNewLine & _  
            "PresFormat:   " & .PresentationFormat & vbNewLine & _  
            "SlideCount:   " & .SlideCount & vbNewLine & "NoteCount:    " & .NoteCount & vbNewLine & _  
            "HiddenSlides: " & .HiddenSlideCount & vbNewLine & "MultimediaClips: " & .MultimediaClipCount & vbNewLine & _  
            "DateCreated:  " & .DateCreated & vbNewLine & "DateLastPrinted: " & .DateLastPrinted & vbNewLine & _  
            "DateLastSaved: " & .DateLastSaved & vbNewLine & _  
            "TotalEditingTime (mins): " & .TotalEditTime & vbNewLine & _  
            "Template:    " & .Template & vbNewLine & _  
            "Revision:    " & .RevisionNumber & vbNewLine & _  
            "IsShared:    " & .SharedDocument  
 
            End With  
        End If  
        .Save  
        .Close  
    End With  
 
TestDSO_Exit:  
    On Error Resume Next  
    m_oDocument.Close  
    Set m_oDocument = Nothing  
    Set oSummProps = Nothing  
Exit Sub  
 
TestDSO_Error:  
    MsgBox "Unexpected error - " & Err.Number & vbCrLf & vbCrLf & _  
            Err.Description, vbExclamation, "VBAProject - TesDSO"  
    Resume TestDSO_Exit  
 
End Sub  
 
Nie wszystkie właściwości będą zwracały wyniki (lub zwrócą 0) w każdym rodzaju pliku. Np.: PageCount będzie > 0 dla pliku Word'a   
ale dla Skoroszytu Excela właściwość ta będzie równa 0.  
 
Spróbujmy zmienić np.: Autora tego pliku  
 
Sub test()  
    Dim bFlag As Boolean  
    Const strFilePath As String = "C:\Documents and Settings\jr\Pulpit\zeszyt1.xls"  
    Const strNewAuthotName As Variant = vbNullString  
 
    ZmianaAutoraPliku_DSO strFilePath, strNewAuthotName, bFlag  
    If bFlag Then  
        MsgBox "Nastąpił Błąd Procedury", vbExclamation  
    Else  
        MsgBox "Jakoś Przeszło :-)", vbInformation  
    End If  
End Sub  
 
Sub ZmianaAutoraPliku_DSO(strFileName As String, _  
                          ByVal strNewAuthorName As Variant, _  
                          ByRef bErr As Boolean)  
                            
    On Error GoTo ZmianaAutoraPliku_DSO_Error  
 
    '---------------------Wymaga Dsofile.dll------------------------  
    'http://support.microsoft.com/default.aspx?scid=kb;en-us;224351  
    '--------- DSO OLE Document Properties Reader 2.1.  ------------  
 
    Dim m_oDocument As Object 'DSOFile.OleDocumentProperties  
    Dim oSummProps As Object 'DSOFile.SummaryProperties  
 
    Set m_oDocument = VBA.CreateObject("DSOFile.OleDocumentProperties")  
    With m_oDocument  
        .Open strFileName, False  
        If Not .IsReadOnly Then  
            Set oSummProps = .SummaryProperties  
            oSummProps.Author = strNewAuthorName  
        End If  
        .Save  
        .Close  
    End With  
 
ZmianaAutoraPliku_DSO_Exit:  
    On Error Resume Next  
    m_oDocument.Close  
    Set m_oDocument = Nothing  
    Set oSummProps = Nothing  
    Exit Sub  
 
ZmianaAutoraPliku_DSO_Error:  
    bErr = True  
    MsgBox "Unexpected error - " & Err.Number & vbCrLf & vbCrLf & _  
        Err.Description, vbExclamation, "VBAProject - ZmiAutPliDSO"  
    Resume ZmianaAutoraPliku_DSO_Exit  
 
End Sub  
 
No i ostatnia prezentowana możliwość DSOfile tj nadawanie plikom właściwości użytkownika DSOFile.CustomProperty. ich odczyt i usuwanie  
 
Sub DodajCustomProperty_DSO(strFileName As String, _  
                          strCusPropName As String, _  
                          vValue As Variant, _  
                          ByRef bErr As Boolean)  
                            
    On Error GoTo DodajCustomProperty_DSO_Error  
 
    Dim m_oDocument As Object 'DSOFile.OleDocumentProperties  
 
    Set m_oDocument = VBA.CreateObject("DSOFile.OleDocumentProperties")  
    With m_oDocument  
        .Open strFileName, False  
        If Not .IsReadOnly Then  
            .CustomProperties.Add sPropName:=strCusPropName, Value:=vValue  
        End If  
        .Save  
        .Close  
    End With  
 
DodajCustomProperty_DSO_Exit:  
    On Error Resume Next  
    m_oDocument.Close  
    Set m_oDocument = Nothing  
    Exit Sub  
 
DodajCustomProperty_DSO_Error:  
    bErr = True  
    MsgBox "Unexpected error - " & Err.Number & vbCrLf & vbCrLf & _  
        Err.Description, vbExclamation, "VBAProject - DodajCustomProperty"  
    Resume DodajCustomProperty_DSO_Exit  
 
End Sub  
 
Sub CzytajCustomProperty_DSO(strFileName As String, _  
                             ByRef bErr As Boolean)  
    On Error GoTo CzytajCustomProperty_DSO_Error  
 
    Dim m_oDocument As Object 'DSOFile.OleDocumentProperties  
    Dim oCustProp As Object 'DSOFile.CustomProperty  
      
    Set m_oDocument = VBA.CreateObject("DSOFile.OleDocumentProperties")  
    With m_oDocument  
        .Open strFileName, False  
        If Not .IsReadOnly Then  
            For Each oCustProp In .CustomProperties  
                With oCustProp  
                    Debug.Print .Name, TypeName(.Value), .Value  
                      
                    '---żeby usunąć---  
                    '.Remove  
                    '-----------------  
                      
                    '---DSOFile.dsoFilePropertyType---  
                    'Debug.Print .Type  
                    '---------------------------------  
                End With  
            Next  
        End If  
        .Save  
        .Close  
    End With  
 
CzytajCustomProperty_DSO_Exit:  
    On Error Resume Next  
    m_oDocument.Close  
    Set m_oDocument = Nothing  
    Exit Sub  
 
CzytajCustomProperty_DSO_Error:  
    bErr = True  
    MsgBox "Unexpected error - " & Err.Number & vbCrLf & vbCrLf & _  
        Err.Description, vbExclamation, "VBAProject - CzytajCustomProperty"  
    Resume CzytajCustomProperty_DSO_Exit  
 
End Sub  
 
Sub TestyCustomProperty()  
    Dim bFlag As Boolean  
    Const strFilePath As String = "C:\Documents and Settings\tkuchta1\Pulpit\zeszyt1.xls"  
    Const strPropName As String = "strMoja"  
    Const vPropValue As Variant = "125a"  
 
    'DodajCustomProperty_DSO strFileName:=strFilePath, _  
                            strCusPropName:=strPropName, _  
                            vValue:=vPropValue, _  
                            bErr:=bFlag  
      
    CzytajCustomProperty_DSO strFileName:=strFilePath, _  
                             bErr:=bFlag  
      
    If bFlag Then  
        MsgBox "Nastąpił Błąd Procedury", vbExclamation  
    Else  
        MsgBox "Jakoś Przeszło :-)", vbInformation  
    End If  
End Sub  
 
    Prawdą jest ze na razie traktuję to jako zabawkę i nie wiem gdzie można by to w praktyczny sposób wykorzystać ale wiedzy nigdy  
dość. Jak się przyda temat pokontynuuję. Zachęcam jednak do testów :-)