Сохраняйте файлы в папки в зависимости от типа файла

У меня много файлов (.zip, .xlsx, .cis, .csv и т. д.) В папке C: \ Tempfolder. Я ищу код 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

Возможно! Zing

urdearboy 10.08.2018 16:59

Здравствуйте, это не сервис написания кода. Вам нужно попробовать написать код самостоятельно, и мы поможем вам с частями, на которых вы застряли.

Hasib_Ibradzic 10.08.2018 17:00

У меня есть код для извлечения файлов из файла .msg в локальную папку, но мне нужна помощь в их сохранении в разные папки в зависимости от типа файла.

Amith.B 10.08.2018 17:07
0
3
52
1

Ответы 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 

Вы не приняли никаких ответов на свои вопросы - это поможет любому, кто придет позже, выбрать «полезные» ответы. stackoverflow.com/help/someone-answers

Tim Williams 15.08.2018 18:42

Другие вопросы по теме