Question

我编写了一个代码，将电子邮件保存为Folder1中的pdf，并下载Folder2中的附件。现在我遇到的问题是，如果附件具有相同的名称，则会覆盖它。

我尝试添加这段代码，以便自动在附件名称前面添加一个数字，但它没有用。

Dim x As Integer
x = 0
If strFile <> strFile Then
    objAttachments.Item(i).SaveAsFile strFile
    objAttachments.Item(i) = Replace(objAttachments.Item(i), " ", "_")

Else
    strFile = strFile
    objAttachments.Item(i).SaveAsFile x & strFile  
    objAttachments.Item(i) = Replace(objAttachments.Item(i), " ", "_")

    x = x + 1

End If

以下是整个代码：

' Get the path to your My Documents folder
strFolderpath = "C:\Users\Kevin\Downloads\bestanden\"
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 = "C:\Users\Kevin\Downloads\bestanden\"

' 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
            strFile = Replace(strFile, " ", "_")

            ' Save the attachment as a file.
            If strFile <> strFile Then
               objAttachments.Item(i).SaveAsFile strFile
               objAttachments.Item(i) = Replace(objAttachments.Item(i), " ", "_")
            Else
               strFile = strFile
               objAttachments.Item(i).SaveAsFile strFile & x
               objAttachments.Item(i) = Replace(objAttachments.Item(i), " ", "_")

                x = x + 1
            End If
        Next
    End If
Next

Answer 1

你想要这样的东西

一个功能

Function FILE_EXISTS(strFolderPath As String, strFileName As String) As Boolean

With CreateObject("scripting.filesystemobject")
    FILE_EXISTS = .fileexists(strFolderPath & "\" & strFileName)
End With

End Function

然后

strFile="CheckFile.docx"
checkfileexists:
if FILE_EXISTS("c:\",strFile) then
      '    Add a number to strFile
      goto checkfileexists
else
      '   Save
end if

您还可以添加一个上限数字，例如100，以阻止错误中无限计数的可能性

Answer 2

没有外部库的纯VBA＆amp;对象：

select

Answer 3

尝试他的功能

Private Function Unique(FldrPath As String) As String
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")

    Dim FileUnique As String
        FileUnique = FldrPath
    Dim Ext As String
        Ext = "." & FSO.GetExtensionName(FldrPath)

    Dim x As Long
        x = 2
    Do While FSO.FileExists(FileUnique)
        FileUnique = Left(FldrPath, Len(FldrPath) - Len(Ext)) & "(" & x & ")" & Ext
        x = x + 1
    Loop

    Unique = FileUnique
End Function

在您的代码上只需更改以下

即可

strFile = strFolderpath & strFile

到此

strFile = Unique(strFolderpath & strFile)

MSDN：FileExists Method＆amp; GetExtensionName Method

检查文件是否存在，如果是，则添加编号

3 个答案: