Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Word > Word VBA

LinkBack Thread Tools Display Modes
Old 07-09-2014, 01:18 PM   #1
Join Date: Jul 2014
Posts: 1
Dan_M is on a distinguished road
Default Word Macro to remove Metadata to include Excel and Powerpoint files.

I placed theis request in Word Macor because that is where I started i guess. The following macro works perfectly for Word 2010.
Sub ScrubMetaData() 
     ' ScrubMetaData Macro
    Application.FileDialog(msoFileDialogOpen).Filters.Add _ 
    Description:="Word documents (*.doc; *.docx)", _ 
    Dim wdd As Document 
    Dim intRetVal As Integer 
    Dim n As Integer 
    On Error Goto ErrHnd 
     'turn off screen updating so we don't see
     'all the documents opened and closed again
    Application.ScreenUpdating = False 
     'set the file open dialog filters
    Application.FileDialog(msoFileDialogOpen).Filters.Add _ 
    Description:="Word documents (*.doc; *.docx)", _ 
     'setup and show the Open dialog box
    With Application.FileDialog(msoFileDialogOpen) 
        .Title = "Select Documents to Clean" 
         'set start folder
        .InitialFileName = "C:\temp\" 
        .AllowMultiSelect = True 
         'show the dialog box and get the button that was clicked
        intRetVal = .Show 
         'check that user selected Open (-1) rather than Cancel (0)
        If intRetVal = -1 Then 
             'iterate through the selected documents
            For n = 1 To .SelectedItems.Count 
                 'open document
                Set wdd = Documents.Open(.SelectedItems(n)) 
                 'clear personal data from document
                wdd.RemoveDocumentInformation (wdRDIAll) 
                 'save and close document
                wdd.Close SaveChanges:=True 
            Next n 
        End If 
    End With 
     'turn on screen updating
    Application.ScreenUpdating = True 
    Exit Sub 
     'error handler
     'turn on screen updating
    Application.ScreenUpdating = True 
End Sub
I am trying To include Excel files And Powerpoint files.
Basically 1 macro To copy into Word, Excel And Powerpoint.
Having alot of trouble.

I had some help With the following redone code, but only Excel works -

Sub ScrubMetadataExcel() 
     'Macro for cleaning personal data from files within selected folder.
    Dim objFS As Object, objFolder As Object 
    Dim objFiles As Object, objF1 As Object 
    Dim WordFile As Object 
    Dim PowerPointFile As Object 
    Dim FolderPath As FileDialog 
    Dim FolderName As String 
    Dim DocType As String 
    Dim CurrentFile As String 
    Set WordFile = CreateObject("Word.Application") 
    Set PowerPointFile = CreateObject("PowerPoint.Application") 
    Set FolderPath = Application.FileDialog(msoFileDialogFolderPicker) 
    With FolderPath 
        .AllowMultiSelect = False 
        FolderName = .SelectedItems(1) 
    End With 
    Set objFS = CreateObject("Scripting.FileSystemObject") 
    Set objFolder = objFS.GetFolder(FolderName) 
    Set objFiles = objFolder.Files 
    For Each objF1 In objFiles 
        CurrentFile = objF1.Path 
        Select Case Right(objF1.Name, 4) 
        Case ".xls", "xlsx", "xlsm" ': DocType = "xlRDIAll"
            Workbooks.Open (CurrentFile) 
            With ActiveWorkbook 
                .RemoveDocumentInformation (xlRDIAll) 
            End With 
        Case ".doc", "docx", "docm" ': DocType = "wdRDIAll"
            WordFile.documents.Open (CurrentFile) 
            With WordFile.ActiveDocument 
                .RemoveDocumentInformation (wdRDIAll) 
            End With 
        Case ".ppt", "pptx", "pptm" ': DocType = "ppRDIAll"
            PowerPointFile.Visible = True 
            PowerPointFile.Presentations.Open (CurrentFile) 
            With PowerPointFile.ActivePresentation 
                .RemoveDocumentInformation (ppRDIAll) 
            End With 
        End Select 
    Set objF1 = Nothing: Set objFiles = Nothing: Set objFolder = Nothing: Set objFS = Nothing 
End Sub
- Banging my head against the wall -
Thanks for any help, I appreciate it.

Last edited by macropod; 07-10-2014 at 01:10 AM. Reason: Added code tags & formatting
Dan_M is offline   Reply With Quote

macro, metadata

Thread Tools
Display Modes

Similar Threads
Thread Thread Starter Forum Replies Last Post
Can a macro rename Excel files based on a cellname? chrisd2000 Excel Programming 1 06-23-2014 06:50 PM
Mail merge from Excel to Word and include hyperlinks chay Mail Merge 5 09-28-2013 01:16 AM
Opening Word /Excel reinstalls files, loses recent files adj1 Office 3 05-10-2013 12:27 AM
Can excel Replace metadata of image files? quiff Excel 0 11-23-2011 12:39 AM
Merging word files from excel macro hklein Excel Programming 0 08-05-2011 02:27 AM

All times are GMT -7. The time now is 08:28 AM.

Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc. is not affiliated with Microsoft