我正试图将一些内部网站点的表格截图粘贴到一封电子邮件中。
每个截图都粘贴到一个新消息中,而我需要它们都在同一个消息中。
我如何专注于初始电子邮件粘贴所有屏幕截图时,通过所有的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)
和平。