vba以从Intranet链接和电子邮件下载

Question

下面是用于从Intranet位置下载一个pdf文件并通过电子邮件发送给一组人员的脚本。 请让我知道如何使其同时下载两个pdf文件

Public WithEvents objReminders As Outlook.Reminders
Dim strSubject As String

Private Sub Application_Startup()
Set objReminders = Outlook.Application.Reminders
End Sub

'When a Reminder Pops up

Private Sub objReminders_ReminderFire(ByVal ReminderObject As Reminder)
Dim objTask As Outlook.TaskItem

'If It's a Task's Reminder
If TypeOf ReminderObject.Item Is TaskItem Then
   Set objTask = ReminderObject.Item

   If strSubject = epo_daily_reports Then
      Wait (30)
      objTask.Complete = True
      objTask.Save
   End If

End If
End Sub

Function Wait(nSeconds As Integer) As Boolean
Dim dCurrentTime As Date

dCurrentTime = Now

Do Until DateAdd("s", nSeconds, dCurrentTime) <= Now
   DoEvents
Loop
End Function



Private Sub Application_Reminder(ByVal Item As Object)
Set olRemind = Outlook.Reminders

If Item.Categories <> "Send Message" Then    
Exit Sub
End If

strSubject = epo_daily_reports
Dim objMsg As MailItem
Set objMsg = Application.CreateItem(olMailItem)

Dim myURL As String
myURL = "https://epclvts-a.ad.epclpcd.net/VTSGUEST/z_reporting/epo/0_EPCL_EPO_MASTER_REPORT.pdf"

Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "xxx\xxxt", "xxx"
WinHttpReq.Send

myURL = WinHttpReq.ResponseBody
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.ResponseBody
oStream.SaveToFile ("C:\Users\vivekm\Desktop\EPO DAILY\0_EPCL_EPO_MASTER_REPORT.pdf"), 2
oStream.Close
End If

Call SendFiles("C:\Users\vivekm\Desktop\EPO DAILY\", "*.pdf")

End Sub

Function SendFiles(fldName As String, Optional FileType As String = "*.*")

Dim fName As String
Dim sAttName As String

Dim olApp As Outlook.Application
Dim olMsg As Outlook.MailItem
Dim olAtt As Outlook.Attachments

Set olApp = Outlook.Application
Set olMsg = olApp.CreateItem(0) ' email
Set olAtt = olMsg.Attachments

' to send all
' fName = Dir(fldName)

'to send only certain extensions
fName = Dir(fldName & FileType)

Do While Len(fName) > 0
olAtt.Add fldName & fName
sAttName = fName & "<br /> " & sAttName
Debug.Print fName
fName = Dir
Loop

' send message
 With olMsg
.Subject = "EPCL EPO DAILY REPORTS"
.To = "viv@gmail.com"
.HTMLBody = "EPCL EPO Daily Report Attached."
.Send
 End With

 End Function

你好

上面是用于从Intranet位置下载一个pdf文件并通过电子邮件发送给一组人员的脚本。

请让我知道如何使其同时下载两个pdf文件。

结果 -在提醒弹出时，从Intranet位置下载两个pdf文件并通过Outlook通过电子邮件发送。