[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[问题求助] [已解决]小弟有個自動發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. Dim xOutLook
  9. Dim xMail
  10. On Error Resume Next
  11. Set xOutLook = GetObject(, "Outlook.Application")
  12. If xOutLook Is Nothing Then
  13.     Set xOutLook = CreateObject("Outlook.Application")
  14. End If
  15. Set xMail = xOutLook.CreateItem(olMailItem)
  16. With xMail
  17.     .Display
  18.     Dim signature
  19.     signature = .HTMLBody
  20.     .To = receiptions
  21.     .Subject = Subject
  22.     .HTMLBody = Body
  23.     .Importance = olImportanceNormal  
  24.     Dim xDoc
  25.     Set xDoc = xMail.Application.ActiveInspector.WordEditor
  26.     If IsArray(Attachments) Then
  27.         Dim attachment
  28.         For Each attachment In Attachments
  29.             .Attachments.Add attachment
  30.         Next
  31.     End If
  32.     .HTMLBody = .HTMLBody & signature
  33.     If autoSend Then
  34.         .Send
  35.     Else
  36.         .Display
  37.     End If
  38. End With
复制代码
這個VBS是上網找的,小弟有個希望,就是可以將當前文件夾內所有PDF都當成附件,例如:C:\Scan 這個文件夾內所有PDF都當成附件
1

评分人数

    • Batcher: 感谢给帖子标题标注[已解决]字样PB + 2

回复 4# aa77dd@163.com

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

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

謝謝大神的幫忙

TOP

回复 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
复制代码
1

评分人数

TOP

回复 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. Dim xOutLook
  9. Dim xMail
  10. On Error Resume Next
  11. Set xOutLook = GetObject(, "Outlook.Application")
  12. If xOutLook Is Nothing Then
  13.     Set xOutLook = CreateObject("Outlook.Application")
  14. End If
  15. Set xMail = xOutLook.CreateItem(olMailItem)
  16. With xMail
  17.     .Display
  18.     Dim signature
  19.     signature = .HTMLBody
  20.     .To = receiptions
  21.     .Subject = Subject
  22.     .HTMLBody = Body
  23.     .Importance = olImportanceNormal  
  24.     Dim xDoc
  25.     Set xDoc = xMail.Application.ActiveInspector.WordEditor
  26. Dim fso, f
  27. Set fso = CreateObject("Scripting.FileSystemObject")
  28. For Each f in fso.GetFolder("C:\Scan\").Files
  29.    If fso.GetExtensionName(f.Path) = "PDF" Then
  30.         .Attachments.Add f.Path
  31.    End If
  32. Next
  33.     .HTMLBody = .HTMLBody & signature
  34.     If autoSend Then
  35.         .Send
  36.     Else
  37.         .Display
  38.     End If
  39. End With
复制代码
雖然沒有提示失敗,不過沒有自動附件,小弟有試過把第5行去掉,不過還是不行,小弟才疏學淺,是不是還有甚麼地方要改一改,還望大神賜學

TOP

  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 行

TOP

返回列表