设为首页收藏本站
切换到宽版

 找回密码
 注册
搜索
批处理之家»论坛 › 其他脚本区 › VBS求助&讨论 › [已解决]小弟有個自動發E-mail的VBS問題
[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发新帖
查看: 17350|回复: 4

[问题求助] [已解决]小弟有個自動發E-mail的VBS問題

[复制链接]
我不是是人
发表于 2015-6-30 15:50:46 | 显示全部楼层 |阅读模式
本帖最后由 我不是是人 于 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


  9. ' 以下代碼無需修改
  10. Dim xOutLook
  11. Dim xMail

  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  

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

  31.     If IsArray(Attachments) Then
  32.         Dim attachment
  33.         For Each attachment In Attachments
  34.             .Attachments.Add attachment
  35.         Next
  36.     End If

  38.     .HTMLBody = .HTMLBody & signature

  40.     If autoSend Then
  41.         .Send
  42.     Else
  43.         .Display
  44.     End If
  45. End With
复制代码
這個VBS是上網找的,小弟有個希望,就是可以將當前文件夾內所有PDF都當成附件,例如:C:\Scan 這個文件夾內所有PDF都當成附件

评分

参与人数 1PB +2 收起 理由
Batcher + 2 感谢给帖子标题标注[已解决]字样

查看全部评分

回复

举报

aa77dd@163.com
发表于 2015-6-30 17:26:12 | 显示全部楼层
  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:32 | 显示全部楼层
回复 2# aa77dd@163.com
  1. sdt = FormatDateTime(Date)
  2. receiptions = "要發的E-mail"
  3. Subject = "收文 " & sdt
  4. Body = "附件是寄件收文，請查收。"
  5. Attachments = Array("希望可以是當前文件夾內所有的PDF文件")
  6. autoSend = False


  9. ' 以下代碼無需修改
  10. Dim xOutLook
  11. Dim xMail

  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  

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

  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

  39.     .HTMLBody = .HTMLBody & signature

  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:12 | 显示全部楼层
回复 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技术 +1 收起 理由
Batcher + 1 乐于助人

查看全部评分

回复

举报

我不是是人
 楼主| 发表于 2015-7-2 15:23:08 | 显示全部楼层
回复 4# aa77dd@163.com

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

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

謝謝大神的幫忙
回复

举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

Archiver|手机版|小黑屋|批处理之家 ( 渝ICP备10000708号 )

GMT+8, 2026-3-17 10:41 , Processed in 0.020144 second(s), 9 queries , File On.

Powered by Discuz! X3.5

© 2001-2026 Discuz! Team.

快速回复 返回顶部 返回列表