Для начала, создайте в вашем файле Excel (куда вы будете добавлять макрос запуска парсера) отдельный VBA-модуль, и поместите туда следующий код:
Код для запуска надстройки, и нужного парсера сайта
#If VBA7 Then ' Office 2010-2013
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As LongPtr, ByVal szURL As String , ByVal szFileName As String , _
ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As LongPtr
#Else ' Office 2003-2007
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long , ByVal szURL As String , ByVal szFileName As String , _
ByVal dwReserved As Long , ByVal lpfnCB As Long ) As Long
#End If
Sub RunSpecificParser(ByVal ParserName$)
On Error Resume Next
If Not AddinStarted Then Exit Sub ' если программа «Парсер» не запущена, то выход из макроса
res$ = Application.Run("StartParser" , ParserName$)
If Len(res$) Then ' если парсер не запустился - в переменной res$ будет текст ошибки
MsgBox res$, vbCritical, "Ошибка запуска парсера"
Exit Sub
Else
' MsgBox "Парсер был запущен, и завершил свою работу", vbInformation
End If
End Sub
Function AddinStarted() As Boolean
On Error Resume Next
' проверяем, запущена ли надстройка Parser
Test$ = Application.Run("ParserAddinTest" )
If Err.Number = 0 Then AddinStarted = True : Exit Function
If Err.Number = 1004 Then ' макрос не выполнен - надстройка не запущена
' читаем в реестре путь к файлу надстройки, пытаемся найти и запустить надстройку
AddinPath$ = GetSetting("Parser" , "Setup" , "AddinPath" , "" )
If FileExists(AddinPath$) Then
Set WB = Workbooks.Open (AddinPath$) ' пробуем открыть (запустить) надстройку
t = Timer: Err.Raise 777
While (Err > 0) And (Abs(Timer - t) < 6)
Err.Clear: DoEvents: Test$ = Application.Run("ParserAddinTest" ) ' снова проверяем
Wend
If Err.Number = 0 Then AddinStarted = True : Exit Function
End If
End If
' надстройка не запустилась, не найдена, или какая-то другая проблема
ttl$ = "Для работы этого файла необходима надстройка «Парсер сайтов»"
msg$ = "Необходимая для работы этого файла надстройка «Parser» не найдена на вашем компьютере." & vbNewLine & vbNewLine & _
"Скачать и запустить надстройку?"
If MsgBox(msg, vbQuestion + vbOKCancel, ttl$) = vbCancel Then Exit Function
URL$ = "http://excelvba.ru/updates/download.php?addin=Parser"
AddinPath$ = CreateObject("WScript.Shell" ).SpecialFolders("Desktop" ) & "\Parser.xla"
Kill AddinPath$
If URLDownloadToFile(0, URL$, AddinPath$, 0, 0) = 0 Then ' надстройка успешно загружена
If FileExists(AddinPath$) Then
Workbooks.Open AddinPath$ ' пробуем открыть (запустить) надстройку
Err.Clear: Test$ = Application.Run("ParserAddinTest" ) ' снова проверяем
If Err.Number = 0 Then AddinStarted = True : Exit Function
End If
End If
msg$ = "Не удалось скачать и запустить надстройку с сайта ExcelVBA.ru" & vbNewLine & _
"(возможно, приложению Excel закрыт доступ в интернет)" & vbNewLine & vbNewLine & _
"После нажатия кнопки ОК в этом сообщении, будет открыта страница программы," & vbNewLine & _
"где вы сможете скачать надстройку «Parser» (после чего запустить её, и продолжить работу с этим файлом)"
MsgBox msg$, vbExclamation, "При загрузке или запуске надстройки возникли проблемы"
CreateObject("wscript.Shell" ).Run "http://excelvba.ru/programmes/Parser"
End Function
Private Function FileExists(ByVal filename$) As Boolean
On Error Resume Next : FileExists = CreateObject("Scripting.FileSystemObject" ).FileExists(filename$)
End Function
После этого, в модуль ЭтаКнига (если вы хотите, чтобы парсер запускался вместе с открытием вашего файла Excel) добавьте следующий код:
Private Sub Workbook_Open()
' автоматически срабатывает при открытии книги
RunSpecificParser "НазваниеЗапускаемогоПарсера"
End Sub Во вложении — файл с этим кодом, а также с возможностью для пользователя отменить автоматический запуск парсера в течение 5 секунд после открытия файла. Такой файл можно закинуть
в планировщик задач Windows