Question

我在C：\ Tempfolder中有很多文件（.zip，.xlsx，.cis，.csv等）。我正在寻找一个VBA代码，根据文件类型将文件保存到不同的文件夹中。

如果可以，请告诉我吗？

Sub Extrct()

Application.StatusBar = "Extracting..."
    Dim strSearchFolder As String
    Dim date1 As Date
    Dim strOutputFolder As String
    Dim i As Integer
    Dim strFile As String
    Dim sItem   As String

    ThisWorkbook.Activate
    Sheets("Macro").Select
    completepth = Range("M22").Value
    sItem = completepth

    strSearchFolder = sItem & "\"
    MkDir sItem & "\" & "temp"
    strOutputFolder = sItem & "\" & "temp" & "\"

    Set OL = New Outlook.Application
    ur = 0
    strFile = Dir$(strSearchFolder & "*.MSG")

    Dim iprog As Integer, pctCompl As Integer
     Do While strFile <> vbNullString
        ur = ur + 1
        Set Msg = OL.CreateItemFromTemplate(strSearchFolder & strFile)

        For i = 1 To Msg.Attachments.Count
            dateFormat = Format(Now, "yyyy-mm-dd hh-mm-ss")
            Msg.Attachments(i).SaveAsFile strOutputFolder & dateFormat & Chr(32) & Msg.Attachments(i).Filename
            Application.Wait (Now + TimeValue("00:00:01"))
        Next i

        Set Msg = Nothing
        strFile = Dir
        um = um + 1
    Application.StatusBar = "Extracting Mails.. " & ur
    Loop

    Set OL = Nothing

End Sub

Answer 1

未测试

Dim fName
'...
For i = 1 To Msg.Attachments.Count
        dateFormat = Format(Now, "yyyy-mm-dd hh-mm-ss")
        fName = dateFormat & " " & Msg.Attachments(i).Filename
        Msg.Attachments(i).SaveAsFile strOutputFolder & _
                                      SubFolder(fName) & "\" & _
                                      fName
        Application.Wait (Now + TimeValue("00:00:01"))
Next i
'...

添加此功能：

'return subfolder based on file type
Function SubFolder(fName) As String
    dim ext
    ext = createobject("scripting.filesystemobject").GetExtensionName(fName)
    If ext Like "xl*" Then SubFolder = "Excel"
    If ext Like "doc*" Then SubFolder = "Word"
    '...etc

    If SubFolder = "" Then SubFolder = "Misc" '<<catch-all for unrecognized types
End function

根据文件类型将文件保存到文件夹

1 个答案: