Question

我写了2个Subs使日常任务自动化。

第一个子MatriksFlowUpdate调用另外两个子RightClick and SingleClick，以模拟在屏幕的特定部分上的右键单击和左键单击。这样做是为了提示另一个程序创建一个Excel文件并将其保存在C：下。该子程序本身可以正常工作（即，它在屏幕上的所需位置模拟了右键单击和左键单击，提示另一个程序生成Excel工作表）

第二个子CloseInstance查找上面创建的Excel工作表，然后将其关闭。此子项也可以单独正常工作。

但是，当我尝试在另一个子MainSequence中一个接一个地调用这两个子时，出现一个错误，提示找不到应该被第二个子关闭的Excel。所以我在下面位置的CloseInstance子上收到错误

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

我已经尝试了很多方法来解决此问题，但是我觉得过去几天我一直在转圈。任何帮助将不胜感激。

P.S。我第一次在stackoverflow上发布一个q，所以请耐心接受格式设置。

    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的建议，这是调用Sleep函数时的Excel冻结问题。调用Sleep函数时，Excel冻结并阻止了第三方程序创建自己的Excel实例。

我基于这个想法，创建了一个名为WasteTime的新函数并将其添加到我的代码中。我在代码中使用此功能而不是Sleep，从而绕过了Excel冻结问题。

现在下面是完整代码。

请注意，在myonlinetraininghub.com上找到了WasteTime子项

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

结束子

Answer 2

也许可以尝试类似的事情

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

Answer 3

应该是一个计时问题，您可以继续尝试并获取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

每个VBA子程序都可以完美地单独工作，但是从另一个函数调用子程序不起作用

3 个答案: