• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 797
  • Last Modified:

Delete Office Documents Customer Document Properties


I am in need of some code that can be used to loop through a folder of MS office documents and delete each documents custom document properties.

We are migrating document from one SharePoint farm to another and the custom document properties are preventing them from being loaded to the new farm.

Below is the code i have attempted so far however i am having trouble with the delete customer document properties.

Sub RemoveMetaData()
Dim fd As FileDialog
Dim PathOfSelectedFolder As String
Dim SelectedFolder
Dim SelectedFolderTemp
Dim MyPath As FileDialog
Dim fs
Dim ExtraSlash
ExtraSlash = "\"
Dim MyFile
Dim WordObj As Object
Set WordObj = CreateObject("Word.Application")
Dim DocObj As Object
Dim vMyFileString As String

Dim PPObj As Object
Set PPObj = CreateObject("PowerPoint.application")
Dim oProp As DocumentProperty

'Prepare to open a modal window, where a folder is selected
Set MyPath = Application.FileDialog(msoFileDialogFolderPicker)
With MyPath
'Open modal window
        .AllowMultiSelect = False
        If .Show Then
            'The user has selected a folder

            'Loop through the chosen folder

            For Each SelectedFolder In .SelectedItems

                'Name of the selected folder
                PathOfSelectedFolder = SelectedFolder & ExtraSlash
                Set fs = CreateObject("Scripting.FileSystemObject")

                Set SelectedFolderTemp = fs.GetFolder(PathOfSelectedFolder)

                    'Loop through the files in the selected folder

                    For Each MyFile In SelectedFolderTemp.Files
                        'On Error Resume Next
                        'Name of filE
                        'MsgBox MyFile
                        vMyFileString = MyFile
                        Set DocObj = WordObj.Documents.Open(vMyFileString)
                        WordObj.Visible = True
                        MsgBox DocObj
                       For Each oProp In DocObj.CustomDocumentProperties

                        'PPObj.Presentations.Open (vMyFileString)
                        'PPObj.Visible = True


                        'Workbooks.Open FileName:=MyFile

        End If
End With

End Sub

Open in new window

1 Solution

Could you more specific of what kind of error is raised?

Chris BottomleyCommented:
I would suspect a typing issue on line 20 for oProp:

Try using variant i.e. replace:
Dim oProp As DocumentProperty
Dim oProp As variant

From a different perspective, you might want to look at DSOFILE.  This is a COM component you can use to modify document attributes on Office 2003 and before documents.  It can be useful as it does not require Office to be installed, and has a very light footprint.  However it cannot be used on Office 2007 and later files in the open xml formats (.docx, .xlsx, etc).  If you can use it, take a look at the examples here: http://support.microsoft.com/kb/224351
I had some difficulty understanding what you want. So, I have made a few decisions.
1. I decided that your code should run from a macro-enabled Word document.
This is important because in that way you would already have Word running.
2. I decided to deal only with Word documents. It seems that you anticipate to find PowerPoint files as well in your folders, but that is a feature that can be added to my code once you confirm what you need.
Accordingly, please paste the appended code into the code sheet of an otherwise blank Word document and run it from there.
Option Explicit

Sub RemoveMetaData()

    Const BackSlash As String = "\"
    Dim fs As Object
    Dim fd As FileDialog
    Dim SelectedFolder As Variant
    Dim Afile As Variant
    Dim Adoc As Document
    Dim Aprop As Variant
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd                         ' select a folder
        .AllowMultiSelect = False
        If Not .Show Then Exit Sub
        Set SelectedFolder = fs.GetFolder(.SelectedItems(1) & BackSlash)
    End With
    For Each Afile In SelectedFolder.Files
        If Asc(Afile.Name) <> 126 Then
            If InStr(1, Afile.Type, "Word", vbTextCompare) Then
                Set Adoc = Documents.Open(Afile.Path, Visible:=False)
                With Adoc
                    For Each Aprop In .CustomDocumentProperties
                        .Saved = False
                    Next Aprop
                    .Close SaveChanges:=wdSaveChanges
                End With
            End If
        End If
    Next Afile
    Set fd = Nothing
    Set fs = Nothing
End Sub

Open in new window

The code will run much the same as your own version of it, first asking for a folder name and then working on that folder, ignoring all non-Word documents in it as well as any temp files that might be stored there. Sub-folders will not be treated. The documents will be permanently altered. Better keep copies.
I see that there was argument in this thread about whether or not it is necessary to delete the custom properties. On that subject I do not wish to comment. My code deletes the properties as you requested.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now