Board logo

标题: [问题求助] [已解决]小弟有個自動發E-mail的VBS問題 [打印本页]
作者: 我不是是人    时间: 2015-6-30 15:50     标题: [已解决]小弟有個自動發E-mail的VBS問題

本帖最后由 我不是是人 于 2015-7-2 16:12 编辑 
  1. sdt = FormatDateTime(Date)

  2. receiptions = "要發的E-mail"

  3. Subject = "收文 " & sdt

  4. Body = "附件是寄件收文，請查收。"

  5. Attachments = Array("希望可以是當前文件夾內所有的PDF文件")

  6. autoSend = False

  7. 

  8. 

  9. ' 以下代碼無需修改

  10. Dim xOutLook

  11. Dim xMail

  12. 

  13. On Error Resume Next

  14. Set xOutLook = GetObject(, "Outlook.Application")

  15. If xOutLook Is Nothing Then

  16.     Set xOutLook = CreateObject("Outlook.Application")

  17. End If

  18. Set xMail = xOutLook.CreateItem(olMailItem)

  19. With xMail

  20.     .Display

  21.     Dim signature

  22.     signature = .HTMLBody

  23.     .To = receiptions

  24.     .Subject = Subject

  25.     .HTMLBody = Body

  26.     .Importance = olImportanceNormal  

  27. 

  28.     Dim xDoc

  29.     Set xDoc = xMail.Application.ActiveInspector.WordEditor

  30. 

  31.     If IsArray(Attachments) Then

  32.         Dim attachment

  33.         For Each attachment In Attachments

  34.             .Attachments.Add attachment

  35.         Next

  36.     End If

  37. 

  38.     .HTMLBody = .HTMLBody & signature

  39. 

  40.     If autoSend Then

  41.         .Send

  42.     Else

  43.         .Display

  44.     End If

  45. End With
复制代码
這個VBS是上網找的,小弟有個希望,就是可以將當前文件夾內所有PDF都當成附件,例如:C:\Scan 這個文件夾內所有PDF都當成附件
作者: aa77dd@163.com    时间: 2015-6-30 17:26

  1. Dim fso, f

  2. Set fso = CreateObject("Scripting.FileSystemObject")

  3. For Each f in fso.GetFolder("C:\Scan\").Files

  4.    If fso.GetExtensionName(f.Path) = "PDF" Then

  5.         .Attachments.Add f.Path

  6.    End If

  7. Next
复制代码
替换 31-36 行
作者: 我不是是人    时间: 2015-7-1 11:02

回复 2# aa77dd@163.com 
  1. sdt = FormatDateTime(Date)

  2. receiptions = "要發的E-mail"

  3. Subject = "收文 " & sdt

  4. Body = "附件是寄件收文，請查收。"

  5. Attachments = Array("希望可以是當前文件夾內所有的PDF文件")

  6. autoSend = False

  7. 

  8. 

  9. ' 以下代碼無需修改

  10. Dim xOutLook

  11. Dim xMail

  12. 

  13. On Error Resume Next

  14. Set xOutLook = GetObject(, "Outlook.Application")

  15. If xOutLook Is Nothing Then

  16.     Set xOutLook = CreateObject("Outlook.Application")

  17. End If

  18. Set xMail = xOutLook.CreateItem(olMailItem)

  19. With xMail

  20.     .Display

  21.     Dim signature

  22.     signature = .HTMLBody

  23.     .To = receiptions

  24.     .Subject = Subject

  25.     .HTMLBody = Body

  26.     .Importance = olImportanceNormal  

  27. 

  28.     Dim xDoc

  29.     Set xDoc = xMail.Application.ActiveInspector.WordEditor

  30. 

  31. Dim fso, f

  32. Set fso = CreateObject("Scripting.FileSystemObject")

  33. For Each f in fso.GetFolder("C:\Scan\").Files

  34.    If fso.GetExtensionName(f.Path) = "PDF" Then

  35.         .Attachments.Add f.Path

  36.    End If

  37. Next

  38. 

  39.     .HTMLBody = .HTMLBody & signature

  40. 

  41.     If autoSend Then

  42.         .Send

  43.     Else

  44.         .Display

  45.     End If

  46. End With
复制代码
雖然沒有提示失敗,不過沒有自動附件,小弟有試過把第5行去掉,不過還是不行,小弟才疏學淺,是不是還有甚麼地方要改一改,還望大神賜學
作者: aa77dd@163.com    时间: 2015-7-1 15:17

回复 3# 我不是是人

可能是你的 PDF 文件的扩展名并非全是大写, 所以匹配失败, 稍加修改 加入了一个 UCase 函数, 避免大小写不匹配的问题, 在 win7 64位 Outlook 2003 环境用 VBA 宏实测成功发送附件
  1.         Dim fso, f

  2.         Set fso = CreateObject("Scripting.FileSystemObject")

  3.         For Each f In fso.GetFolder("C:\Scan\").Files

  4.             If UCase(fso.GetExtensionName(f.Path)) = "PDF" Then

  5.                  .Attachments.Add f.Path

  6.             End If

  7.         Next
复制代码
作者: 我不是是人    时间: 2015-7-2 15:23

回复 4# aa77dd@163.com

成功了!!! ^ 皿 ^  應該就像大神所說的這邊我的是小寫的.pdf  

親測成功解決問題~~~~成功上附件,成功直接送出~~~

謝謝大神的幫忙



欢迎光临 批处理之家 (http://bathome.net./) Powered by Discuz! 7.2