将焦点从 Outlook 更改为 Excel

Question

我有 Outlook VBA 代码，它可以获取“主题”邮件中的特定文本，然后打开并在 Excel 工作簿中搜索该文本，如果文本存在，则显示一个用户表单。

如何将焦点从 Outlook 设置到 Excel？用户表单保持隐藏状态，仅在我单击 Excel 窗口以激活它时显示。

Sub abrirexecel()
    Dim ExApp As Excel.Application, planilha As String
    On Error Resume Next
    planilha = "'C:\Users\Dyme\" & Format(Date, "yyyy-mm-dd") & "CodesSearch.xlsm'!funcaof12" 

    'funcaof12 is the macro name that opens userform

    Set ExApp = GetObject(, "Excel.Application")
    If Not ExApp Is Nothing Then
        ExApp.Run planilha
    End If
End Sub

有人可以帮忙吗？

Answer 1

您可以通过在用户表单中添加调用函数来将 Excel 用户表单设置为在顶部打开。如果您从 Outlook 调用它，它将在当前不激活 Excel 的情况下打开顶部的表单（需要对调用代码进行一些工作才能正确关闭 excel 会话）

例如：

在用户表单代码中

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub UserForm_Activate()
     'check if we are using XL97 or not (hWndUF global variable)
    hWndUF = IIf(Val(Application.Version) < 9, FindWindow("ThunderXFrame", Me.Caption), FindWindow("ThunderDFrame", Me.Caption))
End Sub

在 Excel 模块中

Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
    ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const SWP_NOSIZE = &H1, SWP_NOMOVE = &H2, HWND_TOPMOST = -1, GW_HWNDNEXT = 2
Private Const FLAGS As Long = SWP_NOMOVE Or SWP_NOSIZE

Public hWndUF As Long

Public Function ShowUserForm()
    Dim uf As Object: Set uf = UserForm1
    uf.Show vbModeless
    If hWndUF <> 0 Then SetWindowPos hWndUF, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
End Function

然后在 Outlook 模块中（这是脏代码，需要更好的对象控制；以后可以看看）

Sub ShowExcelUserForm()
    ' Requires reference: Microsoft Excel x.0 Data Objects library
    Dim ExApp As Excel.Application: Set ExApp = New Excel.Application 'Set ExApp = GetObject(, "Excel.Application")
    If Not ExApp Is Nothing Then
        ExApp.Run "'C:\Users\snapier\Desktop\Stack Overflow 2019.xlsm'!ShowUserForm"
    End If
End Sub