尝试在 Outlook 2013 中设置一个 VBA 模块，将附件自动保存到文件夹中

Question

我正在 Outlook 中设置一个脚本，将一些 PDF 附件保存为收到日期。 这会将文件保存到所需的位置，但不会将其命名为收到的日期，我该如何添加？

这里可能有很多未使用的代码，因为我是从另一个网站获取的，并且删除了一些我不想要的东西，例如在保存附件后删除附件。

Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String

' Get the path to your My Documents folder
strFolderpath = "D:\Documents\"
On Error Resume Next

' Instantiate an Outlook Application object.

Set objOL = CreateObject("Outlook.Application")

' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection

' Set the Attachment folder.
strFolderpath = strFolderpath

' Check each selected item for attachments. If attachments exist,
' save them to the strFolderPath folder and strip them from the item.
For Each objMsg In objSelection

' This code only strips attachments from mail items.
' If objMsg.class=olMail Then
' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
strDeletedFiles = ""

If lngCount > 0 Then

' We need to use a count down loop for removing items
' from a collection. Otherwise, the loop counter gets
' confused and only every other item is removed.

For i = lngCount To 1 Step -1

' Save attachment before deleting from item.
' Get the file name.
strFile = objAttachments.Item(i).FileName

' Combine with the path to the Temp folder.
strFile = strFolderpath & strFile

' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strFile

'write the save as path to a string to add to the message
'check for html and use html tags in link
If objMsg.BodyFormat <> olFormatHTML Then
strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
Else
strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
strFile & "'>" & strFile & "</a>"
End If

'Use the MsgBox command to troubleshoot. Remove it from the final code.
'MsgBox strDeletedFiles

Next i

' Adds the filename string to the message body and save it
' Check for HTML body
If objMsg.BodyFormat <> olFormatHTML Then
objMsg.Body = vbCrLf & "The file(s) were saved to " & strDeletedFiles & vbCrLf &     objMsg.Body
Else
objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" &     objMsg.HTMLBody
End If
objMsg.Save
End If
Next

ExitSub:

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

Answer 1

您想用文件名更改的任何内容都将在此修改后的代码段中，

strFile = strFolderpath & objAttachments.Item(i).FileName 'Add the folder and filename
strFile = left(strfile, len(strFile)-4) 'Strip the .PDF
strFile = strFile & format(Date, "MMddYYYY") & ".PDF"  'Add the date and readd .PDF      
objAttachments.Item(i).SaveAsFile strFile

要尝试不同的日期格式， 请查看此

Answer 2

1. 将以下函数添加到您的代码中：

   函数 Dateiendung(vDateiname As String) As String

   Dim Wortlaenge 作为整数

   Dim StellePunkt 作为整数

   Wortlaenge = Len(vDateiname) ' Anzahl Zeichen des Dateinamens

   StellePunkt = InStrRev(vDateiname, ".") ' Anzahl Zeichen vor dem letzten Punkt

   Dateiendung = Right(vDateiname, Wortlaenge - StellePunkt) ' Dateiendung wird extrahiert

   结束函数

2. 在代码的开头添加这一行：

   将 fileext 调暗为字符串

3. 代替：

   strFile = objAttachments.Item(i).FileName

你必须把：

fileext = Dateiendung(objMailSel.Attachments.item(i).FileName)
strfile = Mid(objMailSel.Attachments.item(i).FileName, 1, Len(objMailSel.Attachments.item(i).FileName) - Len(fileext) - 1) & " " & Format(Date, "MMddYYYY") & " ." & fileext