Страницы: 1
RSS
Перемещение файлов по данным из ячейки
 
Добрый день.

Просьба помочь в решении проблемы. Имеется общий файл с данными и через него формируются отдельные файлы, которые сохраняются только в заданной папке. К сожалению, никак не удается настроить перемещение файлов в созданную папку. Папка создается по принципу текущей даты

Это макрос по созданию отдельных файлов
Код
       ThisWorkbook.Worksheets("Акт приема-передачи").Copy
        iFullName = ThisWorkbook.path & "\тест папки\2020\" & Date &".xlsx"
        ActiveWorkbook.SaveAs Filename:=iFullName
       ActiveWorkbook.Close


А это макрос по созданию папок
Код
    Const strRootFolder As String = "C:\Users\Àíòîí\Desktop\êîíôèäåíöèàëüíûå äåëà\òåñò ïàïêè\"
     
    Dim strYear As String, strMonth As String
    Dim i As Long
     
    strYear = Format(Date, "yyyy")
    strMonth = Format(Date, "dd.mm.yyyy")

     
    If Dir(strRootFolder & strYear, vbDirectory) = "" Then
        MkDir strRootFolder & strYear
    End If
     
    If Dir(strRootFolder & strYear & "\" & strMonth, vbDirectory) = "" Then
        MkDir strRootFolder & strYear & "\" & strMonth
    End If
Изменено: Tonchik133 - 07.04.2020 16:16:15
 
Код
iFullName = ThisWorkbook.path & "\тест папки\2020\" & Date &"\" & Date & ".xlsx"
Вроде пропущена папка с датой та что создаётся в папке год.
 
Удалось решить вопрос самостоятельно
Код
 Const strRootFolder As String = "C:\Users\Антон\Desktop\Акты передачи дел\"
     
    Dim strYear As String, strMonth As String
    Dim y As Long
     
    strYear = Format(Date, "yyyy")
    strMonth = Format(Date, "dd.mm.yyyy")

     
    If Dir(strRootFolder & strYear, vbDirectory) = "" Then
        MkDir strRootFolder & strYear
    End If
     
    If Dir(strRootFolder & strYear & "\" & strMonth, vbDirectory) = "" Then
        MkDir strRootFolder & strYear & "\" & strMonth
    End If

ThisWorkbook.Worksheets("Акт приема-передачи").Copy
       iFullName = strRootFolder & strYear & "\" & strMonth & "\" & Date & " - " & Client & ".xlsx"
        ActiveWorkbook.SaveAs Filename:=iFullName
       ActiveWorkbook.Close

Страницы: 1
Наверх