VBA - フォルダ内のすべてのWordフッターを変更 - 互換性がありません

Question

私は、フォルダー（サブフォルダーを含む）内のすべてのWordファイルでフッターを変更するために、以下のVBAコードを使用しています。

これはかなりうまく機能しますが、Word 2003のみです！今私は、Word 2010を使用していると私は、私はエラーを取得するコード起動した場合：

Run-time error 5111. The command is not available on this platform

Private Sub Image16_Click() 

    Dim Suchpfad, oPath 
    Folder = BrowseForFolder("Sélectionnez le dossier où les fichiers doivent être traitées") 
    If Len(Folder) = 0 Then 
     MsgBox "Vous n'avez pas sélectionné un dossier!" 
     Exit Sub 
    Else 
     'ChangeFileOpenDirectory Folder 
     oPath = Folder 
     'MsgBox oPath 
    End If 


'**** Fußzeilen löschen 
    Pfad = oPath 
    With Application.FileSearch 
     .LookIn = Pfad 
     .SearchSubFolders = True 
     .FileType = msoFileTypeWordDocuments 
     .Execute 
     For i = 1 To .FoundFiles.Count 
      strName = .FoundFiles(i) 
      WordBasic.DisableAutoMacros 
      Documents.Open FileName:=strName 
      Dim Abschnitt As Section 
       For Each Abschnitt In ActiveDocument.Sections 
        For j = 1 To 3 
         On Error Resume Next 
         Abschnitt.Footers(j).Range.Delete 
        Next j 
       Next 

       If ActiveWindow.View.SplitSpecial <> wdPaneNone Then 
     ActiveWindow.Panes(2).Close 
    End If 
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _ 
     ActivePane.View.Type = wdOutlineView Then 
     ActiveWindow.ActivePane.View.Type = wdPrintView 
    End If 
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 
    If Selection.HeaderFooter.IsHeader = True Then 
     ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter 
    Else 
     ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 
    End If 
    Selection.WholeStory 
    Selection.Font.Name = "Verdana" 
    Selection.Font.Size = 7 
    Selection.TypeText Text:="First Line of Footer" 
    Selection.TypeParagraph 
    Selection.Font.Size = 6 
    Selection.TypeText Text:="Second Line of Footer" 
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument 

      ActiveDocument.Save 
      ActiveDocument.Close 
     Next 
    End With 
MsgBox "Operation done in " & Pfad & " !!!" 

End Sub 

を私はこの問題を把握することはできませんし、私は誰かが解決策を持っていることを願っています。

Answer 1

まず、再帰的なフォルダ解析ルーチンが必要です。これはうまくいくはずです。

その後

Public Sub RecursiveFolderParse(Folder, dictFiles As Object, sExt As String) 
    Dim SubFolder As Variant 
    Dim File As Variant 

    For Each SubFolder In Folder.SubFolders 
    RecursiveFolderParse SubFolder, dictFiles, sExt 
    Next 

    For Each File In Folder.Files 
    If Right$(File.Name, Len(sExt)) = sExt Then 
     If Not dictFiles.Exists(File.Path) Then 
     dictFiles.Add File.Path, 1 
     End If 
    End If 
    Next 
End Sub 

このルーチンを使用するためには、ここにあなたがそれに応じて各ファイルを処理するあなたの主なサブルーチンです：

Public Sub ProcessAllFiles() 
    Dim sFolder As String 
    Dim dictFiles As Object 
    Dim FileSystem As Object 
    Dim vKeys As Variant 
    Dim sFilename As Variant 
    Dim sExt As String 

    ' define your folder and the extension to look for 
    sFolder = "C:\Test" 
    sExt = "zip" 

    Set dictFiles = CreateObject("Scripting.Dictionary") 
    Set FileSystem = CreateObject("Scripting.FileSystemObject") 

    RecursiveFolderParse FileSystem.GetFolder(sFolder), dictFiles, sExt 
    vKeys = dictFiles.Keys 

    For Each sFilename In vKeys 

    ' process file code goes here 
    MsgBox sFilename 

    Next 

End Sub