Всем привет Помогите пожалуйста закончить макрос. У меня есть много файлов в которых нужно изменить их название, начал писать макрос но я понял что я еще мало знаю по VBA. В середине файлов мне нужно хранить табуляцию если буду открывать их через Excel то она теряется. Если у кого-то есть какие-то идеи помогите
Всем привет Помогите пожалуйста закончить макрос. У меня есть много файлов в которых нужно изменить их название, начал писать макрос но я понял что я еще мало знаю по VBA. В середине файлов мне нужно хранить табуляцию если буду открывать их через Excel то она теряется. Если у кого-то есть какие-то идеи помогитеMarkoYura
Sub Мяу() Set FSO = CreateObject("Scripting.FileSystemObject") Set Fold = FSO.GetFolder(ThisWorkbook.Path) For Each fl In Fold.Files If fl.Name Like "*txt" Then Name ThisWorkbook.Path & "\" & fl.Name As ThisWorkbook.Path & "\" & "XXX" & fl.Name End If Next End Sub
[/vba]
F1(VBA) + "Name Statement" + "DIR" + DO...LOOP
Если очень хочется через FSO [vba]
Код
Sub Мяу() Set FSO = CreateObject("Scripting.FileSystemObject") Set Fold = FSO.GetFolder(ThisWorkbook.Path) For Each fl In Fold.Files If fl.Name Like "*txt" Then Name ThisWorkbook.Path & "\" & fl.Name As ThisWorkbook.Path & "\" & "XXX" & fl.Name End If Next End Sub
Ребята помогите отредактировать код, никак не могу понять в чем ошибка. Очень надо.
[vba]
Код
Sub Test() Dim FileNames As Variant, I As Integer FileNames = Application.GetOpenFilename(MultiSelect:=True) If IsArray(FileNames) Then For I = 1 To UBound(FileNames) Set FSO = CreateObject("Scripting.FileSystemObject") Set Fold = FSO.GetFolder(ThisWorkbook.Path) NameF = FSO.GetBaseName(FileNames(I)) X = Fold & "\" & NameF r = 2 Do While Cells(r, 1) <> "" If Cells(r, 1) = NameF Then Name X.Name As Fold & "\" & Cells(r, 2).Name End If r = r + 1 Loop Next I End If End Sub
[/vba]
Ребята помогите отредактировать код, никак не могу понять в чем ошибка. Очень надо.
[vba]
Код
Sub Test() Dim FileNames As Variant, I As Integer FileNames = Application.GetOpenFilename(MultiSelect:=True) If IsArray(FileNames) Then For I = 1 To UBound(FileNames) Set FSO = CreateObject("Scripting.FileSystemObject") Set Fold = FSO.GetFolder(ThisWorkbook.Path) NameF = FSO.GetBaseName(FileNames(I)) X = Fold & "\" & NameF r = 2 Do While Cells(r, 1) <> "" If Cells(r, 1) = NameF Then Name X.Name As Fold & "\" & Cells(r, 2).Name End If r = r + 1 Loop Next I End If End Sub
Возможно еще кто-то имеет какие-то классные советы как можно такое сделать. @RAN спасибо твоя помощь мне помогла но к конечному результату я так и не добрался-).
Возможно еще кто-то имеет какие-то классные советы как можно такое сделать. @RAN спасибо твоя помощь мне помогла но к конечному результату я так и не добрался-).MarkoYura
Sub Мяу() Dim arr, i&, fPath$ arr = [a1].CurrentRegion.Value On Error Resume Next fPath = ThisWorkbook.Path & "\" For i = 1 To UBound(arr) Name fPath & arr(i, 1) & ".prg" As fPath & arr(i, 2) & ".prg" Next End Sub
[/vba]
[vba]
Код
Sub Мяу() Dim arr, i&, fPath$ arr = [a1].CurrentRegion.Value On Error Resume Next fPath = ThisWorkbook.Path & "\" For i = 1 To UBound(arr) Name fPath & arr(i, 1) & ".prg" As fPath & arr(i, 2) & ".prg" Next End Sub