Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Переместить обработанные файлы в другую папку - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Переместить обработанные файлы в другую папку (Макросы/Sub)
Переместить обработанные файлы в другую папку
Sancho Дата: Среда, 06.07.2016, 16:26 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 279
Репутация: 19 ±
Замечаний: 0% ±

2007, 2010, 2013
Всем привет.
не могу доработать код что бы после обработки макросом переносились уже ненужные файлы во вложенную папку. Нужно что бы в папке, в которой находятся файлы *.xls и *.xlsm макрос сохранил файлы *.xls как *.xlsm внутри этой папки и все обработанные *.xls файлы переносил в созданную макросом вложенную папку.

[vba]
Код

Sub x()

Dim strFolder As String, strFileName As String
    Dim strNewFolder As String, strNewFileName As String
    Dim wb As Workbook
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = 0 Then
            Exit Sub
        End If
        strFolder = .SelectedItems(1)
    End With
    
    strNewFolder = strFolder & "\" & "_" & Format(Now, "dd.mm.yyyy hh.mm.ss")
    MkDir strNewFolder
    
    With Application
        lCalc = .Calculation
        .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: .Calculation = xlManual
    End With
    
        
    strFileName = Dir(strFolder & "\*.xls")
    Do While strFileName <> ""
        Set wb = Workbooks.Open(strFolder & "\" & strFileName)
        strNewFileName = Left(strFileName, InStrRev(strFileName, ".") - 1)
        strNewFileName = strFileName & ".xlsm"
        wb.SaveAs strFolder & "\" & strNewFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False ', xlOpenXMLWorkbook
        wb.Close
        Name strFolder & "\" & strFileName As strNewFolder & "\" & strFileName
        strFileName = Dir
        
    Loop
    
    Application.EnableEvents = True
    Application.DisplayAlerts = False
    Application.ScreenUpdating = True
    
    MsgBox "Готово!", vbInformation
    
End Sub

[/vba]

Помогите пожалуйста.


Сообщение отредактировал Sancho - Четверг, 07.07.2016, 07:53
 
Ответить
СообщениеВсем привет.
не могу доработать код что бы после обработки макросом переносились уже ненужные файлы во вложенную папку. Нужно что бы в папке, в которой находятся файлы *.xls и *.xlsm макрос сохранил файлы *.xls как *.xlsm внутри этой папки и все обработанные *.xls файлы переносил в созданную макросом вложенную папку.

[vba]
Код

Sub x()

Dim strFolder As String, strFileName As String
    Dim strNewFolder As String, strNewFileName As String
    Dim wb As Workbook
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = 0 Then
            Exit Sub
        End If
        strFolder = .SelectedItems(1)
    End With
    
    strNewFolder = strFolder & "\" & "_" & Format(Now, "dd.mm.yyyy hh.mm.ss")
    MkDir strNewFolder
    
    With Application
        lCalc = .Calculation
        .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: .Calculation = xlManual
    End With
    
        
    strFileName = Dir(strFolder & "\*.xls")
    Do While strFileName <> ""
        Set wb = Workbooks.Open(strFolder & "\" & strFileName)
        strNewFileName = Left(strFileName, InStrRev(strFileName, ".") - 1)
        strNewFileName = strFileName & ".xlsm"
        wb.SaveAs strFolder & "\" & strNewFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False ', xlOpenXMLWorkbook
        wb.Close
        Name strFolder & "\" & strFileName As strNewFolder & "\" & strFileName
        strFileName = Dir
        
    Loop
    
    Application.EnableEvents = True
    Application.DisplayAlerts = False
    Application.ScreenUpdating = True
    
    MsgBox "Готово!", vbInformation
    
End Sub

[/vba]

Помогите пожалуйста.

Автор - Sancho
Дата добавления - 06.07.2016 в 16:26
Саня Дата: Среда, 06.07.2016, 17:22 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 1068
Репутация: 560 ±
Замечаний: 0% ±

XL 2016
[vba]
Код
...
        wb.Close

        Name strFolder & "\" & strFileName As strNewFolder & "\" & strFileName

    Loop
...
[/vba]
 
Ответить
Сообщение[vba]
Код
...
        wb.Close

        Name strFolder & "\" & strFileName As strNewFolder & "\" & strFileName

    Loop
...
[/vba]

Автор - Саня
Дата добавления - 06.07.2016 в 17:22
Sancho Дата: Четверг, 07.07.2016, 07:56 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 279
Репутация: 19 ±
Замечаний: 0% ±

2007, 2010, 2013
Саня, Спасибо!

Что то с моим кодом все же не то. файлы сохраняются как *.xls.xlsm не пойму где что я поломал(

строка [vba]
Код
strNewFileName = Left(strFileName, InStrRev(strFileName, ".") - 1)
[/vba] , как я понимаю, должна убирать из названия файла расширение xls


Сообщение отредактировал Sancho - Четверг, 07.07.2016, 08:05
 
Ответить
СообщениеСаня, Спасибо!

Что то с моим кодом все же не то. файлы сохраняются как *.xls.xlsm не пойму где что я поломал(

строка [vba]
Код
strNewFileName = Left(strFileName, InStrRev(strFileName, ".") - 1)
[/vba] , как я понимаю, должна убирать из названия файла расширение xls

Автор - Sancho
Дата добавления - 07.07.2016 в 07:56
Саня Дата: Четверг, 07.07.2016, 12:45 | Сообщение № 4
Группа: Друзья
Ранг: Ветеран
Сообщений: 1068
Репутация: 560 ±
Замечаний: 0% ±

XL 2016
как я понимаю, должна убирать из названия файла расширение xls

именно!

[vba]
Код
        strNewFileName = Left(strFileName, InStrRev(strFileName, ".") - 1)
        strNewFileName = strNewFileName & ".xlsm"     ' strNewFileName = strFileName & ".xlsm"
[/vba]


Сообщение отредактировал Саня - Четверг, 07.07.2016, 12:45
 
Ответить
Сообщение
как я понимаю, должна убирать из названия файла расширение xls

именно!

[vba]
Код
        strNewFileName = Left(strFileName, InStrRev(strFileName, ".") - 1)
        strNewFileName = strNewFileName & ".xlsm"     ' strNewFileName = strFileName & ".xlsm"
[/vba]

Автор - Саня
Дата добавления - 07.07.2016 в 12:45
Sancho Дата: Четверг, 07.07.2016, 14:33 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 279
Репутация: 19 ±
Замечаний: 0% ±

2007, 2010, 2013
Саня, Еще раз огромное спасибо!
 
Ответить
СообщениеСаня, Еще раз огромное спасибо!

Автор - Sancho
Дата добавления - 07.07.2016 в 14:33
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Переместить обработанные файлы в другую папку (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!