将多个屏幕截图粘贴到单个Outlook电子邮件



我正试图将一些内部网站点的表格截图粘贴到一封电子邮件中。

每个截图都粘贴到一个新消息中,而我需要它们都在同一个消息中。

我如何专注于初始电子邮件粘贴所有屏幕截图时,通过所有的url循环?

我提到复制/粘贴多个图片与VBA (Excel到Outlook)。

下面是我的代码:
Sub test()
Dim OutApp As Object
Dim OutMail As Object
Dim ob_urls(1 To 2) As String
Dim item As Variant
'urls
my_urls(1) = "work intranet url 1 - removed"
my_urls(2) = "work intranet url 2 - removed"
Set ie = New InternetExplorerMedium
ie.Visible = True
'loop through urls
For Each item In my_urls
ie.navigate item
'make page wide enough to see tables.
ie.Width = 1400
ie.Visible = True

Do
If ie.readyState = 4 Then
Exit Do
Else
DoEvents
End If
Loop


'delay to load before screen shot, javascript loading
Application.Wait (Now + TimeValue("0:00:7"))

'Print Screen
Application.SendKeys "(%{1068})" '
DoEvents

'Prepare the email
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next

With OutMail
.To = "someone@org.com"
.Subject = "test"
.display
.GetInspector.Activate

'Get its Word editor
OutMail.display
Dim wordDoc As Word.document
Set wordDoc = OutMail.GetInspector.WordEditor

Application.SendKeys "(^v)"

' Crop Image
For Each shp In wordDoc.InlineShapes
shp.PictureFormat.CropTop = 200
shp.PictureFormat.CropBottom = 200
Next
End With
On Error GoTo 0

'toggle true/false to refocus
ie.Visible = False
Next item
End Sub

我明白了。

代替:

'Prepare the email
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

这样做得到所有的屏幕截图在一个电子邮件:

If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
If OutMail Is Nothing Then Set OutMail = OutApp.CreateItem(0)

和平。

相关内容

  • 没有找到相关文章

最新更新