Блог

Я часто запускаю макрос для папок, которые содержат .файлы doc и .docx. В настоящее время мой макрос может редактировать только один тип файла, а затем я должен изменить свой макрос с .doc на .docx (или наоборот) и запустить снова.

Как я мог бы получить оба типа файлов за один раз?

Текущий код.

 'UpdateDocuments 
    
Sub UpdateDocuments()
    Dim file
    Dim path As String
    
    'Path to your folder. 
    'make sure to include the terminating ""
    ‘Enter path.
    path = "C:UsersemckenzieDocumentsTEMP PLOTmacro practiceAndria footer change"
    
    'Change this file extension to the file you are opening
    file = Dir(path amp; "*.docx")
    Do While file <> ""
        Documents.Open FileName:=path amp; file
    
        'This is the call to the macro you want to run on each file the folder
        'Enter macro. 
        Call Permit2hundred
        ' Saves the file
        ActiveDocument.Save
        ActiveDocument.Close
        'set file to next in Dir
        file = Dir()
    Loop
End Sub
 

Чтобы ответить на ваш вопрос:

• Используйте подстановочный знак типа * или ? в этой строке: fileExtension = "*.doc?"
• Вы можете прочитать больше о подстановочных знаках здесь

Некоторые предложения по вашему коду:

• Назначайте типы переменных при их определении
• Сделайте отступ в своем коде (вы можете использовать www.rubberduckvba.com )
• Определите свои переменные близко к тому месту, где вы их впервые используете (зависит от предпочтений)
• При работе с документами присваивайте им переменную document и обращайтесь к этой переменной вместо ActiveDocument
• Используйте базовую обработку ошибок

Дополнительный совет:

• При вызове этой процедуры Permit2hundred вы можете передать targetDocument переменную следующим образом:

     'This is the call to the macro you want to run on each file the folder
    'Enter macro.
    Permit2hundred targetDocument
  
    ' Saves the file
    targetDocument.Save
   

И определение этой процедуры может быть примерно таким:

 Private Sub Permit2hundred(ByVal targetDocument as Document)

    'Do something

End Sub
 

Это переработанный код:

 Public Sub UpdateDocuments()

    ' Add basic Error handling
    On Error GoTo CleanFail
    
    'Path to your folder.
    'make sure to include the terminating ""
    'Enter path.
    Dim folderPath As String
    folderPath = "C:UsersemckenzieDocumentsTEMP PLOTmacro practiceAndria footer change"
    
    'Change this file extension to the file you are opening
    Dim fileExtension As String
    fileExtension = "*.doc?"
    
    ' Get files in folder
    Dim fileName As String
    fileName = Dir(folderPath amp; fileExtension)
    
    ' Loop through files in folder
    Do While file <> vbNullString
        Dim targetDocument As Document
        Set targetDocument = Documents.Open(fileName:=folderPath amp; file)
        
        'This is the call to the macro you want to run on each file the folder
        'Enter macro.
        Permit2hundred
        
        ' Saves the file
        targetDocument.Save
        targetDocument.Close
        
        'set file to next in Dir
        file = Dir()
    Loop
    
CleanExit:
    Exit Sub
CleanFail:
    MsgBox "Something went wrong. Error: " amp; Err.Description
    GoTo CleanExit
End Sub
 

Дайте мне знать, если это сработает

Я предпочитаю отображать диалоговое окно выбора файла, а затем выбирать то, что я хочу. Затем я могу выбрать файл doc или docx без необходимости изменять свой код. Свойство Filter определяет разрешенные типы файлов. Обратите внимание, что этот код очищает фильтр, когда он заканчивается, в противном случае это слово фильтра будет использоваться с этого момента, даже для инициированных вручную (непрограммных) запросов на открытие файла.

Этот пример настроен на разрешение множественного выбора. Вы можете изменить AllowMultiSelect на False, и тогда код будет выполняться только с одним файлом одновременно.

 Dim i As Integer, selFiles() As String
Dim strFolderPath As String, Sep As String
Sep = Application.PathSeparator
Erase selFiles

    'Windows Office 2019, 2016, 2013, 2010, 2007
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Select the files to update"
        .InitialFileName = curDir
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "All Word Files", "*.docx; *.docm; *.doc", 1
        If .Show = 0 Then
            Exit Sub
        End If
        ReDim Preserve selFiles(.SelectedItems.Count - 1)
        strFolderPath = Left(.SelectedItems(1), InStrRev(.SelectedItems(1), Sep))
        For i = 0 To .SelectedItems.Count - 1
            selFiles(i) = .SelectedItems(i   1)
        Next
        .Filters.Clear
    End With