从超链接下载和打印文件

时间:2018-08-15 08:26:17

标签: hyperlink outlook outlook-vba

在编码方面,我完全是菜鸟,下面是我尝试复制/粘贴以下载电子邮件中带有链接文本“下载”的文件的方法。

我需要帮助修复它,因为当前它只是给我一个错误“无法下载文件,或者源URL不存在。”链接所在的位置。

我要做的是下载电子邮件中超链接中的文件(带有文本下载),然后打印它们,因为我找不到直接从超链接中直接打印它们的方法。

Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias _
  "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
  ByVal lpFile As String, ByVal lpParameters As String, _
  ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then
    If Dir(LocalFilename) <> vbNullString Then
        DownloadFile = True
    End If
End If
End Function



Sub HyperlinkAddress()

Dim msg As Object
Dim oDoc As Object
Dim h As Object
Dim i As Integer

Set msg = ActiveExplorer.Selection.Item(1)

If msg.GetInspector.EditorType = olEditorWord Then

    Set oDoc = msg.GetInspector.WordEditor

    For Each h In oDoc.Hyperlinks
        'Debug.Print "Displayed text: " & h.texttodisplay & vbCr & " - Address: " & h.Address
        If h.texttodisplay = "Download" Then
        Debug.Print h.Address
        'Call PrintFile(h.Address)
        ShellExecute 0, "print", h.Address, vbNullString, vbNullString, 0
        i = 1
        If Not DownloadFile(h.Address, "C:\\Users\XYZ\Desktop" & i & ".pdf") Then
            MsgBox "Unable to download the file, or the source URL doesn't exist."
        End If
        i = i + 1
        'MsgBox vbOKOnly
        h.Follow
        End If
    Next

End If

Set msg = Nothing
Set oDoc = Nothing
Set h = Nothing

End Sub

0 个答案:

没有答案