Изменить несколько файлов Excel - без ошибок, без результатов - PullRequest
Новая
       16

Изменить несколько файлов Excel - без ошибок, без результатов

0 голосов
/ 15 марта 2020

Мне просто нужно изменить содержимое двух ячеек, как вы видите, на все файлы в определенной папке, но ничего не происходит при запуске скрипта. Без ошибок, без результатов. 

Sub ModifyAllFiles()

    On Error Resume Next
    MyPath = "Macintosh HD:Users:Danespola:Desktop:test"
    If MyPath = "" Then Exit Sub
    On Error GoTo 0

    If Right(MyPath, 1) <> Application.PathSeparator Then
        MyPath = MyPath & Application.PathSeparator
    End If

    FilesInPath = Dir(MyPath, MacID("XLSX"))
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

    Fnum = 0
     Do While FilesInPath <> ""
     Fnum = Fnum + 1
     ReDim Preserve MyFiles(1 To Fnum)
     MyFiles(Fnum) = FilesInPath
     FilesInPath = Dir()
    Loop

    If Fnum > 0 Then

    Do While Filename <> ""
      Application.ScreenUpdating = False
        Workbooks(FilesInPath).Open
        Range("A5").Value = "ca1"
        Range("A6").Value = "ca2"
        Workbooks(FilesInPath).Save
        Workbooks(FilesInPath).Close
        Filename = Dir()
    Loop
  Application.ScreenUpdating = True

    End If

End Sub

Спасибо!

1 Ответ

0 голосов
/ 17 марта 2020

Не нужно считать файлы или создавать массив, просто обновляйте их по мере их обнаружения. 

Sub ModifyAllFiles()

    Dim Filename As String, MyPath As String, count As Integer
    Dim wb As Workbook, t0 As Single
    t0 = Timer

    MyPath = "Macintosh HD:Users:Danespola:Desktop:test"
    If Right(MyPath, 1) <> Application.PathSeparator Then
        MyPath = MyPath & Application.PathSeparator
    End If

    ' this may not work for excel files created with windows
    'Filename = Dir(MyPath, MacID("XLSX"))

    Filename = Dir(MyPath)
    If Filename = "" Then
        MsgBox "No files found"
        Exit Sub
    Else
        Application.ScreenUpdating = False

        Do While Filename <> ""
            If LCase(Right(Filename, 5)) = ".xlsx" Then
                count = count + 1
                Set wb = Workbooks.Open(MyPath & Filename)
                With wb.Sheets(1)
                   .Range("A5").Value = "ca1"
                   .Range("A6").Value = "ca2"
                End With
                wb.Save
                wb.Close
            End If
            Filename = Dir()
        Loop
        Application.ScreenUpdating = True
    End If
    MsgBox count & " files updated", vbInformation, "Finished in " & Int(Timer - t0) & " secs"

End Sub
...