將焦點重新設置為Excel，Mac VBA 2016

Question

我目前在Excel 2016 for MAC 2016中使用以下VBA代碼：

Sub MailWorkSheet()

Dim SourceWb As Workbook, DestWb As Workbook, sh As Worksheet
Dim strbody As String, TempFileName As String

If Val(Application.Version) < 15 Then Exit Sub

Application.Calculation = xlCalculationManual

Application.DisplayAlerts = False

'Check if the Script File is in the correct location
If CheckScript(ScriptFileName:="ExcelOutlook.scpt") = False Then
MsgBox "Sorry the ExcelOutlook.scpt file is not in the correct
location, " & _
"Email File Manually."
Exit Sub
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Set reference to the source workbook
Set SourceWb = ActiveWorkbook

'Create the body text in the strbody string
strbody = "<FONT size=""3"" face=""Calibri"">"

strbody = strbody & "Hello:" & "<br>" & "<br>" & _
"XXXXXXX." & "<br>" & _
" " & "<br>" & _
"XXXXXXX." & "<br>" & _
" " & "<br>" & _
"XXXXXXX!!"

strbody = strbody & "</FONT>"

'Copy the ActiveSheet to a new workbook
ActiveSheet.Copy
Set DestWb = ActiveWorkbook

'Delete the button on the one sheet workbook
On Error Resume Next
DestWb.Sheets(1).DrawingObjects.Visible = True
DestWb.Sheets(1).DrawingObjects.Delete
On Error GoTo 0

'Enter the name of the file just created
TempFileName = "Long Lane Merit Sheet" & " " _
& Range("A2") & " " & Format(Now, "mmm-dd-yy")

'Call the MailWithMac function to save the new file and create the
mail
MailWithMac _
subject:="XXXXXXX", _
mailbody:=strbody, _
toaddress:=Range("A3"), _
ccaddress:="", _
bccaddress:="", _
displaymail:=True, _
accounttype:="", _
accountname:="", _
attachment:=TempFileName, _
FileFormat:=SourceWb.FileFormat

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

'Turn on Automatic Calculation
Application.Calculation = xlCalculationAutomatic

'Turn Alert Messages On
Application.DisplayAlerts = True

End Sub

通過Outlook通過電子郵件發送當前工作表非常有用。

我遇到的問題是我希望焦點返回到Excel工作表。 現在正在發生的情況是，將彈出Outlook屏幕以及新的電子郵件。 點擊發送后，新的電子郵件屏幕消失，但是Outlook主窗口仍然保留。

如何將焦點重新設置為Excel？

Answer 1

我發現解決方案是使用Applescript達到預期的效果。 這是整個腳本：ption顯式

子MailWorkSheet（）

'Only working in Excel 2016 for the Mac with Outlook 2016
Dim SourceWb As Workbook, DestWb As Workbook, sh As Worksheet
Dim strbody As String, TempFileName As String
Dim RunMyScript As String

'Exit the sub if it is Mac Excel 2011 or lower
If Val(Application.Version) < 15 Then Exit Sub

'Turn off Automatic Calculation
Application.Calculation = xlCalculationManual

'Turn off Alerts
Application.DisplayAlerts = False

'Check if the Script File is in the correct location
If CheckScript(ScriptFileName:="ExcelOutlook.scpt") = False Then
    MsgBox "Sorry the ExcelOutlook.scpt file is not in the correct location, " & _
    "Email File Manually."
    Exit Sub
End If

With Application
    '.ScreenUpdating = False
    .EnableEvents = False
End With

'Set reference to the source workbook
Set SourceWb = ActiveWorkbook

'Create the body text in the strbody string
strbody = "<FONT size=""3"" face=""Calibri"">"

strbody = strbody & "Hello:" & "<br>" & "<br>" & _
    "XXXXXXX" & "<br>" & _
    " " & "<br>" & _
    "XXXXXXX" & "<br>" & _
    " " & "<br>" & _
    "XXXXXXX"

strbody = strbody & "</FONT>"

'Copy the ActiveSheet to a new workbook
ActiveSheet.Copy
Set DestWb = ActiveWorkbook

'Delete the button on the one sheet workbook
On Error Resume Next
DestWb.Sheets(1).DrawingObjects.Visible = True
DestWb.Sheets(1).DrawingObjects.Delete
On Error GoTo 0

'Enter the name of the file just created
TempFileName = "XXXXXXX" & " " _
    & Range("A2") & " " & Format(Now, "mmm-dd-yy")

'Call the MailWithMac function to save the new file and create the mail
MailWithMac _
subject:="XXXXXXX", _
mailbody:=strbody, _
toaddress:=Range("A3"), _
ccaddress:="", _
bccaddress:="", _
displaymail:=True, _
accounttype:="", _
accountname:="", _
attachment:=TempFileName, _
FileFormat:=SourceWb.FileFormat

With Application
    '.ScreenUpdating = True
    .EnableEvents = True
End With

'Minimize Outlook
RunMyScript = AppleScriptTask("ExcelOutlook.scpt", "Mini", _
    "/Library/Application Scripts/com.microsoft.Excel/ExcelOutlook.scpt")

'Turn on Automatic Calculation
Application.Calculation = xlCalculationAutomatic

'Turn Alert Messages On
Application.DisplayAlerts = True

結束子

函數MailWithMac（主題為字符串，主體為字符串，_ toaddress為字符串，ccaddress為字符串，_ bccaddress為字符串，displaymail為布爾值，_ accounttype為字符串，accountname為String，_附件為String，FileFormat為Long）

'Function to create a mail with the activesheet

Dim FileExtStr As String, FileFormatNum As Long
Dim TempFilePath As String, fileattachment As String
Dim ScriptStr As String, RunMyScript As String

Select Case FileFormat
    Case 52: FileExtStr = ".xlsx": FileFormatNum = 52
    Case 53:
        If ActiveWorkbook.HasVBProject Then
            FileExtStr = ".xlsm": FileFormatNum = 53
        Else
            FileExtStr = ".xlsx": FileFormatNum = 52
        End If
    Case 57: FileExtStr = ".xls": FileFormatNum = 57
    Case Else: FileExtStr = ".xlsb": FileFormatNum = 51
 End Select

'Save the new temporary workbook and close it
TempFilePath = _
    MacScript("return POSIX path of (path to home folder) as string")

With ActiveWorkbook
    .SaveAs TempFilePath & attachment & FileExtStr, FileFormat:=FileFormatNum
    .Close SaveChanges:=False
End With

'Build the AppleScriptTask parameter string
fileattachment = TempFilePath & attachment & FileExtStr
ScriptStr = subject & ";" & mailbody & ";" & toaddress & ";" & ccaddress & ";" & _
    bccaddress & ";" & displaymail & ";" & accounttype & ";" & _
    accountname & ";" & fileattachment

'Call the ExcelOutlook Script with the AppleScriptTask Function
RunMyScript = AppleScriptTask("ExcelOutlook.scpt", "CreateMailinOutlook", CStr(ScriptStr))

'Delete the file we just mailed
KillFile fileattachment

結束功能

函數CheckScript（ScriptFileName As String）As Boolean

'Function to Check if the AppleScriptTask script file exists
Dim AppleScriptTaskFolder As String
Dim TestStr As String

AppleScriptTaskFolder = MacScript("return POSIX path of (path to desktop folder) as string")
AppleScriptTaskFolder = Replace(AppleScriptTaskFolder, "/Desktop", "") & _
    "Library/Application Scripts/com.microsoft.Excel/"

On Error Resume Next
TestStr = Dir(AppleScriptTaskFolder & ScriptFileName, vbDirectory)

On Error GoTo 0
If TestStr = vbNullString Then
    CheckScript = False
Else
    CheckScript = True
End If

結束功能

函數KillFile（Filestr作為字符串）

'Function to Kill File
Dim ScriptToKillFile As String
Dim Fstr As String

'Delete files from a Mac using Applescript to avoid probelsm with long file names
If Val(Application.Version) < 15 Then
    ScriptToKillFile = "tell applicatoin " & Chr(34) & _
        "Finder" & Chr(34) & Chr(13)
    ScriptToKillFile = ScriptToKillFile & _
        "do shell script ""rm"" & quoted form of posix path of " & _
        Chr(34) & Filestr & Chr(34) & Chr(13)
    ScriptToKillFile = ScriptToKillFile & "end tell"

    On Error Resume Next
    MacScript (ScriptToKillFile)
    On Error GoTo 0
Else
    Fstr = MacScript("return POSIX path of (" & _
        Chr(34) & Filestr & Chr(34) & ")")
    On Error Resume Next
    Kill Fstr
End If

結束功能

Applescript：

在CreateMailInOutlook（paramString）上，將{fieldValue1，fieldValue2，fieldValue3，fieldValue4，fieldValue5，fieldValue6，fieldValue7，fieldValue8，fieldValue9}設置為SplitString（paramString，“;”）告訴應用程序“ Microsoft Outlook”，如果fieldValue7 =“ pop”，然后將Account設置為名稱為fieldValue8的第一個彈出帳戶將NewMail設置為（使用屬性{subject：fieldValue1，content：fieldValue2，account：theAccount}創建新的傳出消息），否則，如果fieldValue7 =“ imap”，則將該帳戶設置為名稱為第一個imap帳戶fieldValue8將NewMail設置為（使用屬性{subject：fieldValue1，content：fieldValue2，account：theAccount}創建新的傳出消息），否則將NewMail設置為（使用屬性{subject：fieldValue1，content：fieldValue2}創建新的傳出消息）如果告訴NewMail結束在我的SplitString（fieldValue3，“，”）中與toRecipient重復，在屬性為{電子郵件地址：{地址：toRecipient的內容}}的收件人的末尾，使收件人成為新收件人。 在我的SplitString（fieldValue4，“，”）中，在屬性為{電子郵件地址：{地址：toRecipient的內容}}的抄送收件人的末尾，為收件人重新創建收件人，並在我的SplitString（fieldValue5，“，”）中的收件人重復重復在屬性為{電子郵件地址：{地址：toRecipient的內容}}的密件抄送收件人的末尾，向收件人發送重復，並以屬性{file：POSIX file fieldValue9作為別名}創建新附件

        if fieldValue6 as boolean = true then
            open NewMail
            activate NewMail
        else
            send NewMail
        end if
    end tell
end tell

結束CreateMailInOutlook

在SplitString（TheBigString，fieldSeparator）上告訴AppleScript將oldTID設置為文本項定界符將文本項目定界符設置為fieldSeparator將theItems設置為TheBigString文本項將文本項定界符設置為oldTID end告訴返回return theItems end SplitString

在Mini（）上告訴應用程序“ Microsoft Outlook”，告訴（其ID不是（獲取前窗口的ID）並且visible為true的窗口）將小型化設置為true end tell end tell end Mini