Каждая подпрограмма VBA прекрасно работает отдельно, но вызов подпрограмм из другой функции не работает

Question

Я написал 2 сабвуфера для автоматизации ежедневного задания.

Первая подпрограмма MatriksFlowUpdate вызывает 2 другие подпрограммы RightClick and SingleClick для имитации щелчка правой кнопкой мыши и затем щелчка левой кнопкой мыши в определенной части экрана.Это сделано для того, чтобы другая программа предложила создать файл Excel и сохранить его в C :.Эта подпрограмма работает правильно сама по себе (т.е. она имитирует щелчок правой кнопкой мыши и щелчок левой кнопкой мыши в нужных местах на экране, запрашивая другую программу для создания листа Excel)

Второй подпрограмма CloseInstance находит лист Excelсоздан выше, и закрывает его.Этот саб также правильно работает сам по себе.

Однако, когда я пытаюсь вызвать эти 2 саба один за другим в другом сабвуфере MainSequence, я получаю сообщение об ошибке, указывающее, что Excel должен быть найден и закрытвторой саб не может быть найден.Поэтому я получаю сообщение об ошибке в сабвуфере CloseInstance в расположении ниже

    Set xlApp =GetObject("C:\MATRIKS\USER\REPORTS\EXCEL\Temp.xls").Application

Я пробовал много вещей, чтобы это исправить, но я чувствую, что последние несколько дней хожу по кругу.Любая помощь будет высоко ценится.

PS Я впервые публикую aq на stackoverflow, поэтому, пожалуйста, потерпите меня с форматированием.

    Public Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
    Public Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
    Public Const MOUSEEVENTF_LEFTDOWN = &H2
    Public Const MOUSEEVENTF_LEFTUP = &H4
    Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
    Public Const MOUSEEVENTF_RIGHTUP As Long = &H10
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

    Sub MainSequence()
        'This sub pieces together MatriksFlowUpdate and CloseInstance
        Call MatriksFlowUpdate                                        
        Sleep 2000
        Call CloseInstance
        End Sub                                                        

    Sub MatriksFlowUpdate()
        'Prompts 3rd party software (Matriks) to produce Excel with latest flow data
        Call RightClick
        Call SingleClick
        End Sub

    Private Sub RightClick()
    'Simulates a mouse right click at desired screen coordinates
    Sleep 1000
    SetCursorPos 1750, 750 'x and y position
    mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
    mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
    End Sub

    Private Sub SingleClick()
    'Simulates a mouse left click at desired screen coordinates
    Sleep 1000
    SetCursorPos 1750, 650 'x and y position
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
    mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
    End Sub

    Sub CloseInstance()
    'Finds the instance of Excel where Matriks exported its excel and closes that instance of Excel
    Dim xlApp As Excel.Application
    Dim WB As Workbook
    Set xlApp =GetObject("C:\MATRIKS\USER\REPORTS\EXCEL\Temp.xls").Application
    Set WB = xlApp.Workbooks("Temp.xls")
    WB.Close
    End Sub

Answer 1

Благодаря вашей помощи я смог решить проблему, как показано ниже:

согласно предложению DisplayName, это была проблема зависания Excel при вызове функции Sleep.При вызове функции Sleep Excel завис и заблокировал стороннюю программу от создания собственного экземпляра Excel.

Я опирался на эту идею, создал новую функцию под названием WasteTime и добавил ее в свой код.Я использую эту функцию вместо Sleep в коде, тем самым обходя проблему с зависанием Excel.

Полный код ниже.

Обратите внимание, что саб WasteTime был найден на myonlinetraininghub.com

Public Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

Sub MainSequence()
    'This sub pieces together MatriksFlowUpdate and CloseInstance
    Call MatriksFlowUpdate                                        
    WasteTime(2) #This is the code change, it was Sleep 2000 before
    Call CloseInstance
    End Sub                                                        

Sub MatriksFlowUpdate()
    'Prompts 3rd party software (Matriks) to produce Excel with latest flow data
    Call RightClick
    Call SingleClick
    End Sub

Private Sub RightClick()
'Simulates a mouse right click at desired screen coordinates
Sleep 1000
SetCursorPos 1750, 750 'x and y position
mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Sub

Private Sub SingleClick()
'Simulates a mouse left click at desired screen coordinates
Sleep 1000
SetCursorPos 1750, 650 'x and y position
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

Sub CloseInstance()
'Finds the instance of Excel where Matriks exported its excel and closes that instance of Excel
Dim xlApp As Excel.Application
Dim WB As Workbook
Set xlApp =GetObject("C:\MATRIKS\USER\REPORTS\EXCEL\Temp.xls").Application
Set WB = xlApp.Workbooks("Temp.xls")
WB.Close
End Sub

Sub WasteTime(Finish As Long) #This is what I use instead of Sleep
Dim NowTick As Long
Dim EndTick As Long

EndTick = GetTickCount + (Finish * 1000)

Do
    NowTick = GetTickCount
    DoEvents
Loop Until NowTick >= EndTick

End Sub

Answer 2

Если это проблема времени, вы можете продолжать пытаться получить приложение Excel, пока оно не будет найдено (не проверено):

Sub CloseInstance()
    'Finds the instance of Excel where Matriks exported its excel and closes that instance of Excel
    Dim xlApp As Excel.Application

    On Error Resume Next
    Do
        Set xlApp = GetObject("C:\MATRIKS\USER\REPORTS\EXCEL\Temp.xls").Application
        DoEvents
    Loop While xlApp Is Nothing
    xlApp.Workbooks("Temp.xls").Close
End Sub

Answer 3

Может быть попробовать что-то подобное

Sub CloseInstance()
    Dim WB As Workbook
    Set WB = Application.Workbooks("Temp.xls")
    If Not WB Is Nothing Then
        WB.Close
    End If
End Sub

Или попробуйте открыть

Sub test()
IsWorkBookOpen ("C:\MATRIKS\USER\REPORTS\EXCEL\Temp.xls")
End Sub
Sub IsWorkBookOpen(ByVal fullFileName)
Dim wBook As Workbook
If FileExists(fullFileName) Then
    On Error Resume Next
    'Test to see if a Workbook is open.
    Set wBook = Workbooks(Dir(fullFileName))
        If wBook Is Nothing Then 'Not open
            Workbooks.Open (fullFileName)
            Set wBook = Nothing
            On Error GoTo 0
        Else 'It is open
            MsgBox "Yes it is open", vbInformation, "Founded"
            Set wBook = Nothing
            On Error GoTo 0
        End If
Else
    MsgBox "File does not exists"
End If
End Sub


Function FileExists(ByVal fullFileName) As Boolean
    FileExists = VBA.Len(VBA.Dir(fullFileName)) > 0
End Function