在编码方面,我完全是菜鸟,下面是我尝试复制/粘贴以下载电子邮件中带有链接文本“下载”的文件的方法。
我需要帮助修复它,因为当前它只是给我一个错误“无法下载文件,或者源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