Question

我有一封带有pdf附件的电子邮件，当它们进入我的收件箱时，我想自动保存。我的代码大部分是编写的，我测试了所有变量的值都正确，并且它们输出了正确的数据；但是，我不确定如何对文件的实际保存进行编码。

该文件将被重命名为客户的地址，该地址是通过我的以下代码提取的：

Sub EagleViewSaveAttachment()

    'Define Variables
    Dim sFileName As String
    Dim varAddress As Variant
    Dim City As Variant
    Dim fdObj As Object
    Dim NextFriday As Date
    Dim JobArea As String
    Dim JobCity As Variant
    Dim myPath As String
    Dim objAtt As Outlook.Attachment
    Dim myFinalPath As String

    'Set Variables
    NextFriday = Date + 8 - Weekday(Date, vbFriday)
    myPath = "C:\Users\admin\OneDrive\Documents\EagleView\"

    Set myfolder = Outlook.ActiveExplorer.CurrentFolder
    Set fdObj = CreateObject("Scripting.FileSystemObject")

    'Loop through emails in folder
    For i = 1 To myfolder.Items.Count
        Set myitem = myfolder.Items(i)
        msgtext = myitem.Body

        'Search for Specific Text
        delimitedMessage = Replace(msgtext, "Address: ", "###")
        delimitedMessage = Replace(delimitedMessage, ",", "###")
        varAddress = Split(delimitedMessage, "###")

        'Assign the job address from email to variable
        sFileName = varAddress(10)
        JobCity = LTrim(varAddress(11))

        'Define office area based on job city

        If JobCity = "Panama City" Or JobCity = "Mexico Beach" Or JobCity = "Panama City Beach" Or JobCity = "Lynn Haven" Or JobCity = "Port Saint Joe" Then
            JobArea = "Panama"
        ElseIf JobCity = "Daytona Beach" Or JobCity = "Port Orange" Or JobCity = "Deltona" Or JobCity = "Ormond Beach" Or JobCity = "Deland" Then
            JobArea = "Daytona"
        ElseIf JobCity = "Orlando" Then
            JobArea = "Orlando"
        ElseIf JobCity = "Jacksonville" Then
            JobAre = "Jacksonville"
        Else
            JobArea = LTrim(varAddress(11))
        End If

        'Define Final Path
        myFinalPath = myPath + Format$(NextFriday, "yyyy-mm-dd") + "\" + JobArea + "\"

        'Check if the path exists, if not create it
        If fdObj.FolderExists(myFinalPath) Then
            MsgBox "Found it."
        Else
            fdObj.CreateFolder (myFinalPath)
            MsgBox "It has been created."
        End If

    Next

End Sub

截至目前，我无法做的是让它检查目录C:\Users\admin\OneDrive\Documents\EagleView\yyyy-mm-dd\JobArea是否已经存在，并创建它（如果还不存在）。

我相当确定问题出在我对fdObj.FolderExists(myFinalPath)的使用上，因为它似乎不接受变量。

Answer 1

根据我的搜索，fdObj.FolderExists()可以接受变量，如下所示：

Sub Test_File_Exist_FSO_Early_binding()
'If you want to use the Intellisense help showing you the properties
'and methods of the objects as you type you can use Early binding.
'Add a reference to "Microsoft Scripting Runtime" in the VBA editor
'(Tools>References)if you want that.

    Dim FSO As Scripting.FileSystemObject
    Dim FilePath As String

    Set FSO = New Scripting.FileSystemObject

    FilePath = "C:\Users\Ron\test\book1.xlsm"

    If FSO.FileExists(FilePath) = False Then
        MsgBox "File doesn't exist"
    Else
        MsgBox "File exist"
    End If

End Sub

引用来自：

Test if Folder, File or Sheet exists or File is open

您可以保存并重命名附件，请参考以下链接：

Save attachments to a folder and rename them

Answer 2

使用这种功能

Private Function CreateDir(FldrPath As String)
    Dim Elm As Variant
    Dim CheckPath As String

    CheckPath = ""
    For Each Elm In Split(FldrPath, "\")
        CheckPath = CheckPath & Elm & "\"

        If Len(Dir(CheckPath, vbDirectory)) = 0 Then
            MkDir CheckPath
            Debug.Print CheckPath & " Folder Created"
        End If

        Debug.Print CheckPath & " Folder Exist"
    Next
End Function

然后称呼它

示例

    'Define Final Path
    myFinalPath = myPath + Format$(NextFriday, "yyyy-mm-dd") + "\" + JobArea + "\"

    CreateDir myFinalPath ' <--- call call function

重命名附件并保存

2 个答案: