Изменение имен файлов макросом

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Изменение имен файлов макросом (Макросы/Sub)

MarkoYura

Дата: Понедельник, 12.05.2014, 20:37 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 17

Репутация: 0 ±

Замечаний: 0% ±

2010

Всем привет
Помогите пожалуйста закончить макрос.
У меня есть много файлов в которых нужно изменить их название, начал писать макрос но я понял что я еще мало знаю по VBA.
В середине файлов мне нужно хранить табуляцию если буду открывать их через Excel то она теряется.
Если у кого-то есть какие-то идеи помогите

К сообщению приложен файл: 0763736.7z (13.6 Kb)

Ответить

RAN

Дата: Понедельник, 12.05.2014, 21:03 | Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Архив кривой

Быть или не быть, вот в чем загвоздка!

Ответить

MarkoYura

Дата: Понедельник, 12.05.2014, 21:06 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 17

Репутация: 0 ±

Замечаний: 0% ±

2010

FYI

К сообщению приложен файл: ChangeName.xlsm (15.1 Kb) · 61GM5540C.prg (3.4 Kb)

Ответить

RAN

Дата: Понедельник, 12.05.2014, 21:44 | Сообщение № 4

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

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]

Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Понедельник, 12.05.2014, 21:50

Ответить

MarkoYura

Дата: Вторник, 13.05.2014, 00:27 | Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 17

Репутация: 0 ±

Замечаний: 0% ±

2010

Ребята помогите отредактировать код, никак не могу понять в чем ошибка.
Очень надо.

[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]

Ответить

MarkoYura

Дата: Вторник, 13.05.2014, 00:33 | Сообщение № 6

Группа: Пользователи

Ранг: Новичок

Сообщений: 17

Репутация: 0 ±

Замечаний: 0% ±

2010

Возможно еще кто-то имеет какие-то классные советы как можно такое сделать.
@RAN спасибо твоя помощь мне помогла но к конечному результату я так и не добрался-).

К сообщению приложен файл: ChangeName2.xlsm (18.1 Kb) · 61GM5510C.prg (0.7 Kb)

Сообщение отредактировал MarkoYura - Вторник, 13.05.2014, 00:34

Ответить

RAN

Дата: Вторник, 13.05.2014, 08:38 | Сообщение № 7

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

[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

[/vba]

Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Вторник, 13.05.2014, 17:30

Ответить

MarkoYura

Дата: Вторник, 13.05.2014, 19:56 | Сообщение № 8

Группа: Пользователи

Ранг: Новичок

Сообщений: 17

Репутация: 0 ±

Замечаний: 0% ±

2010

Спасибо, все работает классно

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Изменение имен файлов макросом (Макросы/Sub)

Страница 1 из 1
1