Добрый день!
помогите, пожалуйста)
Сколько ни гуглил - не нашел способа решить проблему.
есть макрос, который проходит по папкам/файлам на сервере и обновляет в них запросы Power Query (по очереди), сохраняет файл, переходит к следующему (обычный цикл перебора файлов). Много файлов и в каждом много запросов.
НО если обновляемый файл сбойнул при обновлении, вылетел и хочет заново открыться, то выскакивает окошко с ошибкой типа
"Не удалось... Отправить нахмуренный смайлик".
И ТОЛЬКО если ВРУЧНУЮ нажать "Закрыть", то макрос дальше продолжает работу.
если ли способ, команды VBA, чтобы макрос игнорировал эти окна с ошибками, или сам жал кнопку "закрыть"?
аналогичная проблема, если этот макрос пытается сохранить файл, обычная команда Save,
а сохранение не происходит по причине сбоя сервера, или еще что-то ("Файл занят другим пользователем. Пожалуйста, повторите попытку позже..."), то пока ВРУЧНУЮ не нажмешь "ок" в этом окошке - то макрос дальше не работает.
есть ли команды VBA, чтобы обойти эти окошки как-то, или нажать в них "ок" сразу?
или перед сохранением файла, если не получается вот по каким-то причинам сохранить, то продолжать дальше, перейти к следующему файлу?
Сколько ни гуглил - не нашел...
вот код макроса
| Код |
|---|
Sub Обновление_запросов_в_файлах_папок()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Dim lLastRow As Long
On Error Resume Next
lLastRow = Worksheets("Папки").Cells(Rows.Count, 1).End(xlUp).Row
Set TW = ThisWorkbook 'объявляем короткую объект-переменную, нужна будет для передачи в процедуру RefreshQueries
For i = 2 To lLastRow
WORK_FOLDER = TW.Sheets("Папки").Range("A" & i).Value
If Not IsEmpty(WORK_FOLDER) Then 'если в ячейке не пустота, то
With CreateObject("Scripting.FileSystemObject") 'используем объект, для работы с папками и файлами(позднее связывание)
For Each File In .GetFolder(WORK_FOLDER).Files 'перечисляем все файлы в указанной папке
If InStr(File, ".xls") > 0 Then 'проверяем чтобы в имени файла имелись символы .xls(т.е. это могут быть .xls, xlsm, xlsx, xlsb), эту проверку можно переделать, т.к. если будет файл file.xls.doc, то поймаем ошибку
.CopyFile File, WORK_FOLDER & "\Архив\" & File.Name & " " & Format(Now() - 1, "DD/MM/YYYY") & ".xlsm"
RefreshQueries TW, File, i: DoEvents 'передаем процедуре RefreshQueries параметры - объект нашей книги, полное имя файла и номер строки: после окончания процедуры запускаем DoEvents
End If
Next File
End With
End If
TW.Sheets("Папки").Range("B" & i).Value = DateValue(Now) & " / " & TimeValue(Now): DoEvents
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
End Sub
Private Sub RefreshQueries(ByVal TW As Workbook, ByVal File As String, ByVal Row As Integer)
BValue = TW.Sheets("Папки").Range("B" & Row).Value
CValue = TW.Sheets("Ошибки").Range("A2").Value
Set WO = Workbooks.Open(File)
FName = WO.Name
If WO.ReadOnly = False Then
On Error Resume Next
For Each oc In WO.Connections
oc.OLEDBConnection.BackgroundQuery = False 'отключаем обновление в фоне
oc.Refresh 'обновляем
oc.OLEDBConnection.BackgroundQuery = True 'включаем обновление в фоне
If Err.Number <> 0 Then
'TW.Sheets("Папки").Range("C" & Row).Value = IIf(Len(CValue) = 0, FName & ". " & "Сбой запросов PQ. " & oc.Name, CValue & vbCrLf & FName & ". " & "Сбой запросов PQ. " & oc.Name): DoEvents
TW.Sheets("Ошибки").Range("A2").Value = IIf(Len(CValue) = 0, FName & ". " & "Сбой запросов PQ. " & oc.Name, CValue & vbCrLf & FName & ". " & "Сбой запросов PQ. " & oc.Name): DoEvents
Err.Clear
End If
Next oc
TW.Sheets("Папки").Range("B" & Row).Value = DateValue(Now) & " / " & TimeValue(Now)
WO.Close True
Set WO = Nothing
Else
TW.Sheets("Ошибки").Range("A2").Value = IIf(Len(CValue) = 0, FName & ". " & "Был недоступен для редактирования", CValue & vbCrLf & FName & ". " & "Был недоступен для редактирования"): DoEvents
Err.Clear
WO.Close False
Set WO = Nothing
End If
End Sub
|
