Существует 2 столбца. Столбец A - действующее имя файла. Столбец Б новое имя. Есть необходимость переименовать и скопировать переименованные файлы в отдельную папку. С переименованием разобрался, но как скопировать только переименованные файлы в другую папку?
[vba]
Код
Sub rename() ' ' rename ' Dim OldName As String, NewName As String, sPath As String Dim i As Long, lLastRow As Long sPath = "d:\rename files\" lLastRow = Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To lLastRow OldName = sPath & Cells(i, 1) NewName = sPath & Cells(i, 2) Name OldName As NewName Next i ' End Sub
[/vba]
Существует 2 столбца. Столбец A - действующее имя файла. Столбец Б новое имя. Есть необходимость переименовать и скопировать переименованные файлы в отдельную папку. С переименованием разобрался, но как скопировать только переименованные файлы в другую папку?
[vba]
Код
Sub rename() ' ' rename ' Dim OldName As String, NewName As String, sPath As String Dim i As Long, lLastRow As Long sPath = "d:\rename files\" lLastRow = Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To lLastRow OldName = sPath & Cells(i, 1) NewName = sPath & Cells(i, 2) Name OldName As NewName Next i ' End Sub
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long Sub Macros() Dim ActiveWorkbook_Path As String Dim Folder_Old As String, Folder_New As String Dim OldName As String, NewName As String Dim i As Long, lLastRow As Long ActiveWorkbook_Path = ActiveWorkbook.Path Folder_Old = ActiveWorkbook_Path & "\FolderOld\" Folder_New = ActiveWorkbook_Path & "\FolderNew\" lLastRow = Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To lLastRow OldName = Folder_Old & Cells(i, 1) & ".txt" NewName = Folder_New & Cells(i, 2) & ".txt" CopyFile OldName, NewName, False Next i End Sub
[/vba]
Имена файлов странные
[vba]
Код
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long Sub Macros() Dim ActiveWorkbook_Path As String Dim Folder_Old As String, Folder_New As String Dim OldName As String, NewName As String Dim i As Long, lLastRow As Long ActiveWorkbook_Path = ActiveWorkbook.Path Folder_Old = ActiveWorkbook_Path & "\FolderOld\" Folder_New = ActiveWorkbook_Path & "\FolderNew\" lLastRow = Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To lLastRow OldName = Folder_Old & Cells(i, 1) & ".txt" NewName = Folder_New & Cells(i, 2) & ".txt" CopyFile OldName, NewName, False Next i End Sub
Здравствуйте. Подскажите пожалуйста, а как можно сделать чтоб при копировании проверялось существует ли уже файл с таким именем и если такой файл уже существует в папке, то чтоб его не перезаписывало, а туда закинулась копия с другим именем (напр. Name.txt, Name(2).txt, Name(3).txt, Name(4).txt,.......)
Здравствуйте. Подскажите пожалуйста, а как можно сделать чтоб при копировании проверялось существует ли уже файл с таким именем и если такой файл уже существует в папке, то чтоб его не перезаписывало, а туда закинулась копия с другим именем (напр. Name.txt, Name(2).txt, Name(3).txt, Name(4).txt,.......)alex_alex
А у меня строка красная Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long И код не работает
Может надо в Tools - References подключить библиотеки? Если так то какие?
А у меня строка красная Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long И код не работает
Может надо в Tools - References подключить библиотеки? Если так то какие?Валерьянка