VBA调用Outlook发邮件的时候，mail.display之后如果希望display的邮件出现在窗口最上层要怎么做？

[轮子酱]

如题，因为想在邮件中粘贴一张表格，希望的实现方式是用宏复制表格中的内容，然后邮件display之后模拟键盘操作ctrl+V，但因为display之后的邮件经常不是最上层窗口而失败，想请教各位有啥好办法没有？感激不尽！

[轮子酱]

简单来说就是display邮件之后将邮件置顶显示...小白，恳请尽量详细地说明，感激不尽！！！

[神奇的VBA]

.send之前给个延时

[milaoshu1020]

appactivate

set objShell = CreateObject("wscript.shell")
shell.appactivate "窗口标题",true

[milaoshu1020]

set objShell = CreateObject("wscript.shell")
while not shell.appactivate("窗口标题",true)
    sleep 1000
wend

循环等待...

[轮子酱]

引用 4 楼 milaoshu1020 的回复:

set objShell = CreateObject("wscript.shell")
while not shell.appactivate("窗口标题",true)
    sleep 1000
wend

循环等待...

好的我试试，谢谢！

[轮子酱]

引用 2 楼 神奇的VBA 的回复:

.send之前给个延时

这个试过了，效果不好，附上我目前为止的代码

Sub EmailSend()
'
' EmailSend 宏
'

'



Sheets("INT SLA Dashboard").Select
Dim CurrentTime, CurrentDate, StandarTime9, StandarTime14, StandarTime18, StandarTime10
Dim SendTime As String

CurrentTime = TimeValue(Now())
CurrentDate = Date
Cells(40, 4) = CurrentDate
Cells(43, 4) = TimeValue(Now())
StandarTime9 = TimeValue("09:00")
StandarTime10 = TimeValue("10:00")
StandarTime14 = TimeValue("14:00")
StandarTime18 = TimeValue("18:00")

If CurrentTime <= StandarTime10 Then
SendTime = TimeValue("09:00")
ElseIf CurrentTime > StandarTime10 And CurrentTime <= StandarTime14 Then
SendTime = TimeValue("12:00")
ElseIf CurrentTime > StandarTime14 Then
SendTime = TimeValue("18:00")
End If

Cells(46, 4) = SendTime

Cells(46, 4) = Application.WorksheetFunction.WeekNum(Now())

Dim SubjectTitle, ContentsIncludes As String

SubjectTitle = "EU5&AE Instant SL WK" & CStr(Application.WorksheetFunction.WeekNum(Now())) & " " & CStr(CurrentDate) & " till " & CStr(SendTime)
ContentsIncludes = "Dear all," + vbLf + vbLf + "Please check the detail information of EU5 and AE daily instant SL :" + vbLf + vbLf + "EU5 Instant SL on" + CStr(CurrentDate) + vbLf + vbLf
Cells(46, 1) = SubjectTitle
Cells(49, 1) = ContentsIncludes


Dim Subjects, Contents, ToAdd, ToCC As String

Dim mailapp As Object
Dim Mail


Set mailapp = CreateObject("Outlook.Application")
Set Mail = mailapp.CreateItem(olMailItem)

'Subjects = Sheets("INT SLA Dashboard").Range("A46")
'Contents = Cells(49, 1).Value
ToAdd = Sheets("INT SLA Dashboard").Range("A40")
ToCC = Sheets("INT SLA Dashboard").Range("A43")


Set WshShell = CreateObject("Wscript.Shell")
'Dim time As String
'time = CStr(Now())

With Mail
.To = ToAdd
.CC = ToCC
.Subject = SubjectTitle
.Body = ContentsIncludes

.Display


Range("A1:AA30").Select
Selection.Copy


If Application.Wait(Now + TimeValue("0:00:5")) Then
Dim u As Integer
u = 1
End If

Application.SendKeys "{PGDN}"
Application.SendKeys "{PGDN}"
Application.SendKeys "{PGDN}"

If Application.Wait(Now + TimeValue("0:00:2")) Then
u = 1
End If

WshShell.Run "C:\Users\liuhen\Desktop\Chat自动调整人力建议工具项目\dist\粘贴按键.exe", 0, True
If Application.Wait(Now + TimeValue("0:00:2")) Then
u = 1
End If

.Send
End With

'Mail.Send

Set mailapp = Nothing

Set Mail = Nothing

ActiveWorkbook.Save

End Sub

[轮子酱]

引用 4 楼 milaoshu1020 的回复:

set objShell = CreateObject("wscript.shell")
while not shell.appactivate("窗口标题",true)
    sleep 1000
wend

循环等待...

试了一下，就只会单纯的循环等待下去呢

[milaoshu1020]

"窗口标题"改了吗?改成实际的窗口标题;

[milaoshu1020]

此窗体能被激活吗?激活到最上面;

[轮子酱]

引用 8 楼 milaoshu1020 的回复:

"窗口标题"改了吗?改成实际的窗口标题;

我是改成了"Microsoft Outlook"，之前尝试抓取句柄的时候用这个句柄是没问题的...

[轮子酱]

引用 10 楼 milaoshu1020 的回复:

此窗体能被激活吗?激活到最上面;

问题最后用python解决了，VBA用得不太好，感谢老哥的指导