VBA打开Outlook电子邮件中的第一个链接，然后下一个链接 [英] VBA to open the first link in the Outlook email then the next link

问题描述

如果可能，请告诉我这个或全部的部分。我基本上每天早上有一个电子邮件，5-8个链接到报告（在Sharepoint上），并且必须单击每个，然后打开一个excel文档与报告，点击刷新所有，保存然后回到outlook并点击下一个链接。有没有办法打开Outlook中的第一个链接，转到excel刷新所有，保存，然后回到Outlook并打开下一个链接并重复，直到VBA中的所有链接被按下？任何和所有的帮助是非常感谢，谢谢。

 功能GetCurrentItem（）作为对象
 Dim objApp作为Outlook。应用程序
 
设置objApp =应用程序
错误恢复下一步
选择案例TypeName（objApp.ActiveWindow）
案例资源管理器
设置GetCurrentItem = objApp。 ActiveExplorer.Selection.Item（1）
案例Inspector
设置GetCurrentItem = objApp.ActiveInspector.CurrentItem 
结束选择
 
设置objApp =没有
结束函数
 
 Sub超链接（itm As MailItem）
 Dim bodyString As String 
 Dim bodyStringSplitLine 
 Dim bodyStringSplitWord 
 Dim splitLine 
 Dim splitWord 
 
 bodyString = itm.Body 
 bodyStringSplitLine = Split（bodyString，vbCrLf）
 
对于每个splitLine在bodyStringSplitLine 
 bodyStringSplitWord = Split（splitLine，） 
 
对于每个splitWord在bodyStringSplitWord 
 splitWord.Hyperlink.Select 
下一个
 N ext 
 Set itm = Nothing 
 End Sub 
 
 Sub test（）
 Dim currItem As MailItem 
设置currItem = GetCurrentItem 
超链接currItem 
 End Sub 
  

这是我到目前为止。绝对包含错误。我刚刚运行子测试（）。

解决方案

在Word中有一个。 b
$ b

  Sub超链接（itm As mailitem）
 
 Dim oDoc As Object 
 Dim h As Hyperlink 
 
如果itm.GetInspector.EditorType = olEditorWord然后
 
设置oDoc = itm.GetInspector.WordEditor 
 
对于每个h在oDoc.Hyperlinks 
调试。打印h.Name 
如果右（h.Name，5）=.xlsx然后
 h.Follow 
结束如果
下一个
 
结束如果
 
设置oDoc = Nothing 
 
 End Sub 
  

Please advise me on parts of this or the whole thing if possible. I basically have an email every morning with 5-8 links to reports (on Sharepoint) and have to click each one, which then opens an excel document with the report, click refresh all, save then go back to outlook and click the next link. Is there a way to open the first link in Outlook, go to excel refresh all, save, then go back to Outlook and open the next link and repeat until all links have been pressed in VBA? Any and all help is greatly appreciated, Thank you.

Function GetCurrentItem() As Object
Dim objApp As Outlook.Application

Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
    Case "Explorer"
        Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
    Case "Inspector"
        Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select

Set objApp = Nothing
End Function

Sub Hyperlink(itm As MailItem)
Dim bodyString As String
Dim bodyStringSplitLine
Dim bodyStringSplitWord
Dim splitLine
Dim splitWord

bodyString = itm.Body
bodyStringSplitLine = Split(bodyString, vbCrLf)

For Each splitLine In bodyStringSplitLine
    bodyStringSplitWord = Split(splitLine, " ")

    For Each splitWord In bodyStringSplitWord
        splitWord.Hyperlink.Select
    Next
Next
Set itm = Nothing
End Sub

Sub test()
Dim currItem As MailItem
Set currItem = GetCurrentItem
Hyperlink currItem
End Sub

This is what I have come up with so far. Definitely contains errors. I just run the sub test() in the end.

解决方案

There is a .Follow in Word.

Sub Hyperlink(itm As mailitem)

Dim oDoc As Object
Dim h As Hyperlink

If itm.GetInspector.EditorType = olEditorWord Then

    Set oDoc = itm.GetInspector.WordEditor

    For Each h In oDoc.Hyperlinks
        Debug.Print h.Name
        If Right(h.Name, 5) = ".xlsx" Then
            h.Follow
        End If
    Next

End If

Set oDoc = Nothing

End Sub

这篇关于VBA打开Outlook电子邮件中的第一个链接，然后下一个链接的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！