|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
工作中遇到一个情况,需要将outlook MastCard中邮件的附件另存为并按照一定条件命名。现在已经从邮件正文中把命名的关键字找出来,并赋给Attachment_Name, 但是在将附件另存并命名时遇到困难。
代码如下,运行到 ITM.Attachments(1).SaveAsFile path 时报错 提示无法保存附件,文件名或目录名无效。改成 ITM.Attachments(1).SaveAsFile path & ITM.Attachments(1).FileName 可以正常运行并保存附件,但是无法重命名。 希望能有朋友帮忙解决,多谢啦- Sub findOBinSpec()
- Dim NS As Outlook.NameSpace
- Dim NSR_Number, Region, SiteCode, Attachment_Name, path As String
- Dim attc As Outlook.Attachment
- Dim arr
- Dim x, j As Integer
- Dim FD As MAPIFolder
- Dim ITM As Outlook.MailItem
- Dim fs
- Set fs = CreateObject("Scripting.FileSystemObject")
- path = "C:\Users\pengz\Desktop"
- target = "NSR Number:"
- target2 = "Master Card"
- Dim excel As Object
- Set excel = CreateObject("Excel.Application")
- excel.Visible = True
- Set Workbook = excel.workbooks.Open("C:\Users\pengz\Desktop\xxx.xlsx")
- Workbook.worksheets(1).Select
- Set NS = Session.Application.GetNamespace("MAPI")
- Set FD = NS.GetDefaultFolder(olFolderInbox)
- For i = 1 To FD.Folders.Count
- If FD.Folders(i).Name = "MasterCard" Then
-
- For Each ITM In FD.Folders(i).Items
-
- Debug.Print ITM.Body
-
- arr = Split(ITM.Body, Chr(10))
-
- For j = 0 To UBound(arr)
-
- If InStr(arr(j), "NSR Number") Then
-
- NSR_Number = Split(arr(j), " ")(UBound(Split(arr(j), " ")))
-
- ElseIf InStr(arr(j), "Region") Then
-
- Region = Split(arr(j), " ")(UBound(Split(arr(j), " ")))
-
- ElseIf InStr(arr(j), "SiteCode") Then
-
- SiteCode = Split(arr(j), " ")(UBound(Split(arr(j), " ")))
-
- End If
-
- Next
-
- Attachment_Name = NSR_Number & " " & Region & " " & SiteCode
-
- If ITM.Attachments.Count > 0 Then
- Attachment_Name = Attachment_Name & "." & fs.GetExtensionName(ITM.Attachments(1))
复制代码
|
|