Question

是否可以打开现有的应用程序窗口？

我想要的：为了把重点放在已经开放但不是焦点的应用程序上，代码是什么。例如，使用：

Set objIE = New InternetExplorer

但是我希望宏将焦点放在已经存在的IE上。

这是另一种情况，我让Lotus Notes创建一个包含以下代码的电子邮件：

Sub Email_Bot()

'variables are defined
Dim Maildb As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim Session As Object
Dim AttachME As Object
Dim EmbedObj As Object
Dim Attachment As String
Dim stAttachment As String
Dim Mail_Form As String
Dim Mail_SendTo As String
Dim Mail_Subject As String
Dim Mail_Body As String
Dim Mail_Attachement As Boolean
Dim Mail_Save As Boolean
Dim Mail_Send As Boolean
Dim Mail_Name As String
Dim Mail_Text_1 As String
Dim Mail_Text_2 As String
Dim Mail_Text_3 As String
Dim Mail_Text_4 As String
Dim Mail_Text_5 As String
Dim Mail_Text_6 As String
Dim Mail_Closing As String
Dim Mail_SendBy As String
Dim tb_Mailing_List As Object
Dim tb_Email_Template As Object
Dim LastRow As Integer
Dim Row_Count As Integer
Dim Mail_Body_Lock As Boolean
Dim Workspace As Object
Const EMBED_ATTACHMENT As Long = 1454

'worksheets are defined
Set tb_Mailing_List = ThisWorkbook.Sheets("Mailing List")
Set tb_Email_Template = ThisWorkbook.Sheets("Email Template")

'mail session is defined
Set Session = CreateObject("Notes.NotesSession")
Set Maildb = Session.CURRENTDATABASE
Set MailDoc = Maildb.CREATEDOCUMENT
Set Workspace = CreateObject("Notes.NOTESUIWORKSPACE")

'important variables are set
LastRow = tb_Mailing_List.Cells(Rows.Count, 2).End(xlUp).Row
Row_Count = 3
Mail_Body_Lock = False

'cell assignment
Mail_Text_1 = tb_Email_Template.Cells(4, 4).Value
Mail_Text_2 = tb_Email_Template.Cells(5, 4).Value
Mail_Text_3 = tb_Email_Template.Cells(6, 4).Value
Mail_Text_4 = tb_Email_Template.Cells(7, 4).Value
Mail_Text_5 = tb_Email_Template.Cells(8, 4).Value
Mail_Text_6 = tb_Email_Template.Cells(9, 4).Value
Mail_Closing = tb_Email_Template.Cells(25, 4).Value
Mail_SendBy = tb_Email_Template.Cells(12, 4).Value & vbNewLine & vbNewLine & tb_Email_Template.Cells(13, 4).Value & vbNewLine & tb_Email_Template.Cells(14, 4).Value & vbNewLine & tb_Email_Template.Cells(15, 4).Value & vbNewLine & vbNewLine & tb_Email_Template.Cells(16, 4).Value & vbNewLine & tb_Email_Template.Cells(17, 4).Value & vbNewLine & tb_Email_Template.Cells(18, 4).Value & vbNewLine & tb_Email_Template.Cells(19, 4).Value & vbNewLine & tb_Email_Template.Cells(20, 4).Value & vbNewLine & tb_Email_Template.Cells(21, 4).Value & vbNewLine & tb_Email_Template.Cells(22, 4).Value

'loops until all names have been filled
Do Until Row_Count = LastRow + 1

    'Mail Dashboard
    Mail_Body_Lock = False
    Mail_Send = False
    Mail_Form = "Memo"
    Mail_Name = tb_Mailing_List.Cells(Row_Count, 2).Value
    Mail_SendTo = tb_Mailing_List.Cells(Row_Count, 4).Value
    Mail_Subject = tb_Email_Template.Cells(2, 4).Value
    Mail_Save = True

    'exit round in case the email address is not present
    If Mail_SendTo = "" Then GoTo NoEmail

    'if only body row 1 has text
    If Mail_Text_2 = "" And Mail_Text_3 = "" And Mail_Text_4 = "" And Mail_Text_5 = "" And Mail_Text_6 = "" Then
    Mail_Body = "Dear " & Mail_Name & vbNewLine & vbNewLine & Mail_Text_1 & vbNewLine & vbNewLine & Mail_Closing & vbNewLine & vbNewLine & vbNewLine & Mail_SendBy
    Mail_Body_Lock = True
    End If

    'if only body row 1 and row 2 have text
    If Mail_Body_Lock = False And Mail_Text_3 = "" And Mail_Text_4 = "" And Mail_Text_5 = "" And Mail_Text_6 = "" Then
    Mail_Body = "Dear " & Mail_Name & "," & vbNewLine & vbNewLine & Mail_Text_1 & vbNewLine & Mail_Text_2 & vbNewLine & vbNewLine & Mail_Closing & vbNewLine & vbNewLine & vbNewLine & Mail_SendBy
    Mail_Body_Lock = True
    End If

    'if only body row 1 till row 3 have text
    If Mail_Body_Lock = False And Mail_Text_4 = "" And Mail_Text_5 = "" And Mail_Text_6 = "" Then
    Mail_Body = "Dear " & Mail_Name & vbNewLine & vbNewLine & Mail_Text_1 & vbNewLine & Mail_Text_2 & vbNewLine & Mail_Text_3 & vbNewLine & vbNewLine & Mail_Closing & vbNewLine & vbNewLine & vbNewLine & Mail_SendBy
    Mail_Body_Lock = True
    End If

    'if only body row 1 till row 4 have text
    If Mail_Body_Lock = False And Mail_Text_5 = "" And Mail_Text_6 = "" Then
    Mail_Body = "Dear " & Mail_Name & vbNewLine & vbNewLine & Mail_Text_1 & vbNewLine & Mail_Text_2 & vbNewLine & Mail_Text_3 & vbNewLine & Mail_Text_4 & vbNewLine & vbNewLine & Mail_Closing & vbNewLine & vbNewLine & vbNewLine & Mail_SendBy
    Mail_Body_Lock = True
    End If

    'if only body row 1 till row 5 have text
    If Mail_Body_Lock = False And Mail_Text_6 = "" Then
    Mail_Body = "Dear " & Mail_Name & vbNewLine & vbNewLine & Mail_Text_1 & vbNewLine & Mail_Text_2 & vbNewLine & Mail_Text_3 & vbNewLine & Mail_Text_4 & vbNewLine & Mail_Text_5 & vbNewLine & vbNewLine & Mail_Closing & vbNewLine & vbNewLine & vbNewLine & Mail_SendBy
    Mail_Body_Lock = True
    End If

    'in case there is an error or something
    If Mail_Body_Lock = False Then
    Mail_Body = "Dear " & Mail_Name & vbNewLine & vbNewLine & Mail_Text_1 & vbNewLine & Mail_Text_2 & vbNewLine & Mail_Text_3 & vbNewLine & Mail_Text_4 & vbNewLine & Mail_Text_5 & vbNewLine & Mail_Text_6 & vbNewLine & vbNewLine & Mail_Closing & vbNewLine & vbNewLine & vbNewLine & Mail_SendBy
    End If

    'mail build-up
    MailDoc.Form = Mail_Form
    MailDoc.SendTo = Mail_SendTo
    MailDoc.Subject = Mail_Subject
    MailDoc.Body = Mail_Body

    'attachement build-up
    If tb_Email_Template.Cells(28, 4) <> "" And tb_Email_Template.Cells(29, 4) <> "" Then
    Attachment = tb_Email_Template.Cells(28, 4)
    stAttachment = tb_Email_Template.Cells(29, 4)
    Set AttachME = MailDoc.CREATERICHTEXTITEM("stAttachment")
    Set EmbedObj = AttachME.EmbedObject(EMBED_ATTACHMENT, "", Attachment, "stAttachment")
    End If


    Call Workspace.EDITDOCUMENT(True, MailDoc).GOTOFIELD("Body")
    MsgBox "Email send?"

NoEmail:
Row_Count = Row_Count + 1
Loop

'variable dump
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing

End Sub

之后：

Call Workspace.EDITDOCUMENT(True, MailDoc).GOTOFIELD("Body")

我希望VBA打开那个窗口而不是我必须自己去那里。我确信必须有办法。我使用了鼠标移动，直到一位拥有不同屏幕资源的同事。使用该程序。

我对VBA和编程都很陌生并且自学了所以如果这可能是一个愚蠢的问题我很抱歉，但到目前为止我找不到其他任何答案。

Answer 1

尝试这种方式，

 Public vPID As Variant
 Public Sub OpenApplication()
'Launch application if not already open
If vPID = 0 Then 'Application not already open
101:
    vPID = Shell("C:\Windows\system32\notepad.exe", vbNormalFocus)
Else 'Application already open so reactivate
    On Error GoTo 101
    AppActivate (vPID)
End If
End Sub

由于变量vPID存储为项目级公共变量，因此只要您的Excel（或其他Microsoft Office应用程序）实例处于打开状态，其值就会保留。

vba set专注于Windows应用程序

1 个答案: