Delete Office Documents Customer Document Properties

Hello,

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
                            oProp.Delete
                       Next
                        
                        
                        
                       DocObj.Save
                        

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

                        
                        
                        
                        
                        'PPObj.Presentations.Close
                        'WordObj.Documents.Close
                        DocObj.Close
                        
                       

                        'Workbooks.Open FileName:=MyFile

                    Next
             WordObj.Quit
             'PPObj.Quit
            Next
        End If
End With


End Sub

Open in new window

kriskykAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rgonzo1971Commented:
Hi,

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

Regards
0
Chris BottomleySoftware Quality Lead EngineerCommented:
I would suspect a typing issue on line 20 for oProp:

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

Chris
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
andrewssd3Commented:
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
0
FaustulusCommented:
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
                        .CustomDocumentProperties(Aprop.Name).Delete
                        .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.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft SharePoint

From novice to tech pro — start learning today.