Вопрос № 101668: Доброе время суток!
Помогите, пожалуйста: необходимо написать макрос, который обеспечивает обновление связей с книгами Excel, защищёнными паролями для открытия.
Как сделать так, чтобы макрос самостоятельно вводил пароли, которые запрашиваются...
Вопрос № 101.668
Доброе время суток!
Помогите, пожалуйста: необходимо написать макрос, который обеспечивает обновление связей с книгами Excel, защищёнными паролями для открытия.
Как сделать так, чтобы макрос самостоятельно вводил пароли, которые запрашиваются при обновлении связей?
Заранее большое спасибо за помощь.
Отвечает: HookEst
Здравствуйте, Васильева Екатерина!
Именно при обновлении, пароль задать сложно, но в общем случае, для обновления зависимых данных достаточно просто открыть книгу-источник данных, а вот при открытии мы пароль указать сможем.
Как вариант:
создал книгу;
в Правка->Связи...->Запрос на обновление связей... выставил флажок "Не задавать вопрос и не обновлять связи";
создал ссылки в ней, на Source1.xls(защищен паролем "1"), на Source2.xls(защишен паролем "2") и на Source3.xls(без пароля);
вставил в книгу новый модуль с кодом:
Option Explicit
'возвращает пароль для открытия файла FullName
'реализация может быть любой, у меня просто select...case
Private Function getPwd(ByVal FullName As String) As String
Select Case FullName
Case "D:Source1.xls"
getPwd = "1"
Case "D:Source2.xls"
getPwd = "2"
End Select
End Function
'показывает открыт ли уже файл, расположенный в path
Private Function isOpened(ByVal path As String) As Boolean
Dim wb As Workbook
For Each wb In Workbooks
If wb.FullName = path Then isOpened = True: Exit For
Next wb
End Function
'собственно макрос, который обновляет связанные данные
Sub UpdatePwd()
Dim src As Workbook
Dim wb As Workbook
Dim s As Variant
Dim p As String
'чтоб не моргало
On error resume next
Application.ScreenUpdating = False
Set wb = ThisWorkbook
'только для Excel связей! OLE и DDE - не обновляются!
For Each s In wb.LinkSources(xlExcelLinks)
'если уже открыт, то ничего делать не надо, иначе...
If Not isOpened(s) Then
p = getPwd(s)
If p = "" Then
'если нет пароля, просто обновляем эту связь
wb.UpdateLink s
Else
'пароль есть. на мгновение открываем запароленную книгу
Set src = Workbooks.Open(Filename:=s, Password:=p, ReadOnly:=True)
'данные автоматически обновятся
'и закрываем.
src.Close
End If
End If
Next s
Application.ScreenUpdating = True
End Sub
теперь, чтобы обновить данные, нужно запустить макрос UpdatePwd
Успехов.
Ответ отправил: HookEst (статус: Студент)
Ответ отправлен: 12.09.2007, 08:28
