Страницы: 1
RSS
VBA Фоновое открытие Книг в папке, кроме уже открытых, Макрос должен открывать все Книги в папке, кроме уже открытых
 
Ребята, всем привет! Помогите доработать макрос. Я его нашел на просторах интернета, добавил к своей Книге - работает, но есть нюансы.

Изначальная задача: при открытии Альфа-Книги необходимо в фоновом режиме открыть все Книги в Папке, сохранить изменения и закрыть.
Тестовый запуск показал, что файлы открываются, сохраняются и закрываются нормально. Но только до тех пор, пока не случается ситуация, когда один из файлов в Папке уже кем-то открыт. Тогда работа макроса приостанавливается с запросом сохранения данного файла.

Как бы мне сделать так, чтобы макрос пропускал файлы, если они в данный момент уже открыты?

Если для этого нужно полностью изменить конструкцию макроса - я не против. Файлов в Папке небольшое количество - около 10шт, т.е. даже без изящных циклов LOOP можно, например, просто подряд записать команды для каждого из файлов. Да, топорно, но главное, чтобы работало.

Код
Sub update()
With Application 'операции с приложением/отключаем для повышения скорости работы макроса
.ScreenUpdating = False 'обновление экрана
.DisplayAlerts = False 'вывод системных сообщений
Папка = "C:\Test\"
'------------ Excel-файлы в этой папке ------------------
Имя = Dir(Папка & "*.xlsx")
Do While Имя <> ""
With .Workbooks.Open _
(Filename:=Папка & Имя, UpdateLinks:=True)
'здесь Ваш макрос делает свое грязное дело
.Close SaveChanges:=True
End With
Имя = Dir
Loop
.ScreenUpdating = True 'обновление экрана
.DisplayAlerts = True 'вывод системных сообщений
End With
End Sub
Изменено: boberchik - 23.03.2023 11:52:00
 
Вариант. Создавать копии, работать с ними. Потом копировать файл с заменой, пропуская ошибки.
 
Нарамблерил еще немного информации. Натыкал вот такой макрос:

Код
Function BookOpenClosed(wbName As String) As Boolean
    Dim myBook As Workbook
    On Error Resume Next
        Set myBook = Workbooks(wbName)
    BookOpenClosed = Not myBook Is Nothing
End Function
Sub Primer1()
    If BookOpenClosed("Книга1.xlsx") Then
        MsgBox "Книга открыта"
    Else
        MsgBox "Книга закрыта"
    End If
End Sub


Он работает, но как его интегрировать в мою задачу - у меня мозгов не хватает пока что.
Изменено: boberchik - 23.03.2023 12:31:44
 
Цитата
написал:
Он работает, но
не работает. Этот код не избавит от запроса, если файл кем-то открыт.
 
Как проверить открыта ли книга?
В конце статьи приведен код, который должен Вам помочь. Если книга кем-то уже открыта, функция об этом скажет. Останется только пропустить ту, что открыта.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Функцию проверил, она работает. Но не хватает ума пристроить ее внутрь цикла...
 
Цитата
boberchik написал:
Но не хватает ума
м-да...тяжко Вам придется. В статье конкретный пример приведен, только что цикла нет...
Код
Do While Имя <> ""
If IsBookOpen(Папка & Имя) = False Then
With .Workbooks.Open _
(Filename:=Папка & Имя, UpdateLinks:=True)
'здесь Ваш макрос делает свое грязное дело
.Close SaveChanges:=True
End With
End If
Имя = Dir
Loop
Изменено: Дмитрий(The_Prist) Щербаков - 24.03.2023 09:43:31
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
написал:
м-да...тяжко Вам придется. В статье конкретный пример приведен, только что цикла нет...
Дим, я ж не спец в VBA вообще, мне не придется, мне уже тяжко :). Это не моя основная работа, просто стараюсь автоматизировать свои процессы насколько это возможно. В Excel много чего могу, а вот VBA только-только начинаю изучать. Пока что на уровне "Нагуглить готовый макрос и немного подкорректировать его под свою задачу". Но я учусь :) Всю найденную инфу сохраняю. Нет предела совершенству.

За желание помочь огроменное спасибо! Я внедрил твой код в свой файл - вроде работает как надо. Буду еще тестить.

PS В качестве благодарности за готовый макрос готов закинуть на пару литров томатного сока ;) Кинь в личку контакт
 
Кстати, может быть, кому-то потребуется такую же задачу решать. Вот мой конечный результат:

update: добавил в конце еще обновление всей книги, чтобы все запросы PQ обновились: ThisWorkbook.RefreshAll
Код
'Макрос при открытии Книги открывает все файлы в Папке по очереди, обновляет связи, сохраняет и закрывает. Если файл уже открыт, то он пропускается.
Sub update()
With Application 'операции с приложением/отключаем для повышения скорости работы макроса
.ScreenUpdating = False 'обновление экрана
.DisplayAlerts = False 'вывод системных сообщений
Папка = "C:\Test\"
'------------ Excel-файлы в этой папке ------------------
Имя = Dir(Папка & "*.xlsx")
Do While Имя <> ""
If IsBookOpen(Папка & Имя) = False Then
With .Workbooks.Open _
(FileName:=Папка & Имя, UpdateLinks:=True)
'здесь Ваш макрос делает свое грязное дело
.Close SaveChanges:=True
End With
End If
Имя = Dir
Loop
.ScreenUpdating = True 'обновление экрана
.DisplayAlerts = True 'вывод системных сообщений
End With
ThisWorkbook.RefreshAll
End Sub



Function IsBookOpen(wbFullName As String) As Boolean
    Dim iFF As Integer, retval As Boolean
    iFF = FreeFile
    On Error Resume Next
    Open wbFullName For Random Access Read Write Lock Read Write As #iFF
    retval = (Err.Number <> 0)
    Close #iFF
    IsBookOpen = retval
End Function
Изменено: boberchik - 24.03.2023 11:29:21
 
Так как обновление нескольких файлов занимает какое-то время, то решил добавить возможность выбора - делать обновление файлов или просто открыть данную Книгу:
Код
'чтобы запускался при открытии Книги...
Sub Workbook_Open()

'выводим сообщение с вопросом
Dim RetVal As Long
Retry_:
RetVal = MsgBox("Обновить все связи и запросы? Потребуется около 1 минуты", _
vbYesNo + vbQuestion)
Select Case RetVal
Case vbNo
Exit Sub
Case vbYes
End Select

With Application 'операции с приложением/отключаем для повышения скорости работы макроса
.ScreenUpdating = False 'обновление экрана
.DisplayAlerts = False 'вывод системных сообщений
Папка = "C:\Test\"
'------------ Excel-файлы в этой папке ------------------
Имя = Dir(Папка & "Себестоимость*.xlsx")
Do While Имя <> ""
If IsBookOpen(Папка & Имя) = False Then
With .Workbooks.Open _
(FileName:=Папка & Имя, UpdateLinks:=True)
'здесь Ваш макрос делает свое грязное дело
.Close SaveChanges:=True
End With
End If
Имя = Dir
Loop
.ScreenUpdating = True 'обновление экрана
.DisplayAlerts = True 'вывод системных сообщений
End With
'Neimar, код ThisWorkBook.RefreshAll или ActiveWorkBook.RefreshAll обновляет всё, в том числе и запросы - и имени запросов знать не надо  ;)
'Это макроаналог нажатия кнопки "Обновить всё" на вкладке "Данные".
'Горячая комбинация кнопки — "Ctrl+Alt+F5"
ThisWorkbook.RefreshAll
End Sub



Function IsBookOpen(wbFullName As String) As Boolean
    Dim iFF As Integer, RetVal As Boolean
    iFF = FreeFile
    On Error Resume Next
    Open wbFullName For Random Access Read Write Lock Read Write As #iFF
    RetVal = (Err.Number <> 0)
    Close #iFF
    IsBookOpen = RetVal
End Function

Страницы: 1
Наверх