Получать файлы документов из папок и подпапок с помощью Word VBA - PullRequest
Новая
       7

Получать файлы документов из папок и подпапок с помощью Word VBA

0 голосов
/ 09 мая 2018

Я вставляю кучу документов Word в один файл для последующей обработки. Когда все файлы находятся в одной папке, мой скрипт работает. Однако, чтобы сделать его надежным для будущей работы, я бы хотел вставить файлы Word из всех папок и подпапок (и, возможно, из последующих подпапок) из определенной начальной точки. Я следовал этому уроку Youtube: https://www.youtube.com/watch?v=zHJPliWS9FQ, чтобы рассмотреть все папки и подпапки и, конечно, исправил его для моего конкретного использования. 

  Sub CombineDocs()
    On Error Resume Next
    MsgBox "Opening"
    On Error GoTo 0

    Dim foldername As String 'parent folder
    With Application.FileDialog(msoFileDialogFolderPicker)
      .AllowMultiSelect = False
      .Show
      On Error Resume Next
      foldername = .SelectedItems(1)
      Err.Clear
      On Error GoTo 0
    End With

    Documents.Add
    Selection.Style = ActiveDocument.Styles("Heading 1")
    Selection.TypeText Text:="Opening text"
    Selection.TypeParagraph
    Selection.InsertNewPage
    Selection.InsertBreak Type:=wdSectionBreakNextPage
    ActiveDocument.GoTo(What:=wdGoToPage, Count:=2).Select

    Dim fso As Scripting.FileSystemObject
    Dim file As Scripting.file
    getfolders foldername
  End sub

Sub getfolders(foldername)
    Set fso = New Scripting.FileSystemObject
    Call pastedoc(foldername)
    Set fso = Nothing
End Sub

Sub pastedoc(StartFolderPath as String)
    Dim file As Scripting.file
    Dim subfol As Scripting.folder
    Dim mainfolder As Scripting.folder
    Set mainfolder = fso.GetFolder(StartFolderPath )

    For Each file In mainfolder.Files
    If ((InStr(1, LCase(fso.GetExtensionName(file.Path)), "doc", vbTextCompare) > 0) Or _
         (InStr(1, LCase(fso.GetExtensionName(file.Path)), "docx", vbTextCompare) > 0)) And _
                (InStr(1, file.Name, "~$") = 0) Then
        Selection.InsertFile FileName:= _
        file.Path _
        , Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False
        Selection.InsertBreak Type:=wdSectionBreakNextPage
        End If
    Next file

    For Each subfol In mainfolder.SubFolders
        pastedoc subfol.Path
    Next subfol
End Sub

Разница между моим кодом и учебным пособием заключается в том, что я определяю родительскую папку в основном коде, а учебное пособие делает это в дополнительном сценарии. В результате я получаю

'требуется объект'

ошибка в строке 'set mainfolder'. Я попытался определить все объекты и имена между основным кодом и вызовом подпрограмм, но все еще не могу заставить его работать. Любое руководство, что может исправить код?

1 Ответ

0 голосов
/ 09 мая 2018

Один вариант: предполагая, что End Sub для CombineDocs был после вызова getfolders, вы можете:

  1. Удалить getfolders целиком

  2. В CombineDocs, скажем pastedoc foldername вместо getfolders foldername

  3. Изменить начало pastedoc на: 

    Sub pastedoc(StartFolderPath as String)
    Dim fso As Scripting.FileSystemObject       ' ** Added
    Set fso = New Scripting.FileSystemObject    ' ** Added

    Dim file As Scripting.file
    Dim subfol As Scripting.folder
    Dim mainfolder As Scripting.folder
    Set mainfolder = fso.GetFolder(StartFolderPath )

    ' ... (everything else the same)

Как правило, вам нужно Dim переменных либо в Sub, где они используются, либо в верхней части вашего модуля, вне каких-либо подпрограмм. Пожалуйста, поместите Dim внутри Sub s, когда это возможно, так как это значительно упрощает изменение и поддержку вашего кода.

...