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] Помогите пожалуйста.
Всем привет. не могу доработать код что бы после обработки макросом переносились уже ненужные файлы во вложенную папку. Нужно что бы в папке, в которой находятся файлы *.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
Сообщение отредактировал 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] Саня
Ответить
Сообщение [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
Саня , Спасибо! Что то с моим кодом все же не то. файлы сохраняются как *.xls.xlsm не пойму где что я поломал( строка [vba]Код
strNewFileName = Left(strFileName, InStrRev(strFileName, ".") - 1)
[/vba] , как я понимаю, должна убирать из названия файла расширение xlsSancho
Сообщение отредактировал 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]
как я понимаю, должна убирать из названия файла расширение 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
Ответить
Сообщение Саня , Еще раз огромное спасибо!Автор - Sancho Дата добавления - 07.07.2016 в 14:33