Question

我需要一个只发送.docx文件的脚本指定的文件夹，如果文件名存在，那么它可能不要被覆盖。

请参阅下面我找到的模板，请提供帮助项目...

提前致谢。

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
        saveFolder = "C:\Path\"
    Dim dateFormat As String
        dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd Hmm ")
    For Each objAtt In itm.Attachments
        If FileType = ".docx" Then
        objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
        End If
    Next
End Sub

Answer 1

尝试将您的IF声明替换为：

If Right(objAtt.Filename, 5) = ".docx" Then

FileType用于Access表的附件，但即使您可以使用它，您也需要限定引用（即，告诉VBA您想要FileType的对象），例如：

If objAtt.FileType = "docx" Then

有关带有Outlook附件的here和here的VBA的更多信息。

更新

添加数字if文件已存在。还删除了额外的“\”，这可能会导致保存位置出现意外结果。

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String, dateFormat As String, fName As String
    saveFolder = "C:\Path\"
    dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd Hmm ")
    For Each objAtt In itm.Attachments
        If objAtt.FileType = "docx" Then
            fName = saveFolder & dateFormat & objAtt.DisplayName
            If Dir(fName) <> "" Then 'file already exists
                fName = fName & Int(Timer) 'add a number
            End If
            objAtt.SaveAsFile fName & ".docx"
        End If
    Next
End Sub

编辑＃2：

将下面的代码粘贴到Outlook，Excel或Access中的模块中，并在常量中指定“已处理”编号文件的文件夹和名称“前缀”（如果不存在，则手动创建目标文件夹）。）然后，函数getNextFileName将返回以myFile0001.docx开头的“下一个可用名称”...使用该函数设置objAtt.SaveAsFile文件名，或者将文件另存为，立即使用sub renameSequentially( _ in_Filepath＆amp; name _ )重命名（并可能重新定位）它。

Option Explicit

Function getNextFileName() As String
'returns a string with the next available filename matching the criteria in the Constants below.
    Const folder = "C:\savepathhere\"
    Const filenameStart = "myFile"
    Const filenameEnd = ".docx" 'this will become "C:\savepathhere\myFile0001.docx" etc

    Dim r As String, fileNum As Long, maxFileNum As Long
    Dim numStartPos As Integer, numStopPos As Integer, NextFileName As String

    'start listing existing files
    r = Dir(folder & filenameStart & "*" & filenameEnd)

    If r = "" Then
        maxFileNum = 0 'this will be the file #1
    Else

        Do While r <> ""

            'existing file found. Get the number from it's name
            numStartPos = Len(filenameStart) + 1
            numStopPos = InStr(numStartPos, r, filenameEnd, vbTextCompare)
            fileNum = Val(Mid(r, numStartPos, numStopPos - numStartPos))
            If fileNum > maxFileNum Then maxFileNum = fileNum

            'get next filename
            r = Dir
        Loop

    End If

    'get the new filename
    NextFileName = folder & "\" & filenameStart & Format(maxFileNum + 1, "0000") & filenameEnd
    Debug.Print "Next unusued filename: " & NextFileName

    'double-check that it's available
    If Dir(NextFileName) <> "" Then
        MsgBox "Error! Filename taken: " & NextFileName
        Exit Function
    End If

    getNextFileName = NextFileName

End Function

Function renameSequentially(in_File As String)
'specify path+filename that should be renamed requentiallyto should be renamed sequentially
    Dim newName As String
    newName = getNextFileName
    Name in_File As newName
    If Dir(newName) <> "" Then
        MsgBox in_File & vbLf & " was renamed to:" & vbLf & newName
    Else
        Call MsgBox("Something went wrong trying to rename" & vbLf & in_File & vbLf & " to " & vbLf & newName, vbExclamation, vbOKOnly)
    End If
End Function

Sub test()
renameSequentially ("C:\mysourcepath\abcwxyz.docx") 'renames the file to myfile####.docx
End Sub

使用特定文件类型保存和重命名附件

1 个答案:

更新

编辑＃2：