Question

我创建了一个代码，用于从outlook导出我的文件并将它们发送到一个文件夹（不包括签名）。我的新挑战是确保在下载文件时，如果文件夹中已存在同名文件，则不应运行该代码。

我曾考虑过使用这样的代码但是尝试将它集成到我在本文底部的代码中失败：

Dim TestStr As String


  On Error Resume Next
    TestStr = Dir(FilePath)
  On Error GoTo 0

  If TestStr = "" Then
    FileExist = False
  Else
    FileExist = True
  End If
End Function

到目前为止，我的代码是不成功的，我似乎无法调试：

Public Sub Samenamesameformat(Item As Outlook.MailItem)

Dim Atmt As Outlook.Attachment
Dim SavePath As String
Dim objFSO As Object
Dim sExt As String
Dim TestStr As String

SavePath = "C:\Users\Antoine.moyroud\Documents\Testexportadwords"
On Error Resume Next
    TestStr = Dir(SavePath)
  On Error GoTo 0
If TestStr = "" Then
        FileExist = False
      Else
        FileExist = True
      Set objFSO = CreateObject("Scripting.FileSystemObject")
    For Each Atmt In Item.Attachments
    sExt = objFSO.GetExtensionName(Atmt)
    Select Case sExt
        Case "jpg", "png"
        Case Else
            Atmt.SaveAsFile SavePath & "\" & Atmt.DisplayName
    End Select
End If
Next
Set Atmt = Nothing
End Sub

谢谢！

Answer 1

试试这个

Public Sub Samenamesameformat(Item As MailItem)
    Dim Atmt As Attachment
    Dim SavePath As String
    Dim objFSO As Object
    Dim sExt As String

    SavePath = "C:\Users\Antoine.moyroud\Documents\Testexportadwords"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    For Each Atmt In Item.Attachments
        If Not objFSO.FileExists(SavePath & "\" & Atmt.FileName) Then
            sExt = objFSO.GetExtensionName(Atmt)
            Select Case sExt
                Case "jpg", "png"
                Case Else
                    Atmt.SaveAsFile SavePath & "\" & Atmt.DisplayName
            End Select
        End If
    Next
End Sub

我假设您的子服务从Outlook内部运行，因此您不需要所有Outlook应用程序对象模型变量的.Outlook前缀

如果已导出具有相同名称的文件，则阻止导出Outlook附件

1 个答案: