Страницы: 1
RSS
VBA. Имя файла в каждой строке
 
Помогите, пожалуйста, исправить код.
Имеется 1 файл, в который из нескольких других файлов переносится информация. Нужно, чтобы напротив скопированной строки макрос прописывал имя файла, из которого он ее взял.
У меня по коду получается так, что макрос вписывает название только в 1ю строку из нового файла, а все остальные остаются пустыми до данных из следующего файла.

что не так?
Код
i = 2
Set dirObj = mergeObj.Getfolder("C:\Users\......")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)

... часть макроса с копированием строк

Dim fileName As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fileName = fso.GetFilename(everyObj)


Workbooks("Quarter brandmap macro_test.xlsm").Sheets("copied").Range("AQ" & i).Value = fileName
Application.DisplayAlerts = False

bookList.Close
i = Cells(Rows.Count, 1).End(xlUp).Row + 1
Next
Изменено: Мария - - 19.08.2020 17:32:08
 
1 у вас уже открыта книга источник и её имя bookList.name
2 или вставлять при копировании, а мы не видим как у вас это происходит или
Код
Workbooks("Quarter brandmap macro_test.xlsm").Sheets("copied").Range("AQ" & i).resize(Cells(Rows.Count, 1).End(xlUp).Row + 1-i).Value = bookList.name
По вопросам из тем форума, личку не читаю.
 
копирование файла коротко)
Код
ActiveWorkbook.Sheets("1 Öåíû êîíêóðåíòîâ Ìàñëà").Unprotect Password:="priceMONITOR052020"
Columns("A:B").Select
Selection.Columns.Ungroup
Columns("A:AP").Select
Selection.EntireColumn.Hidden = False
ActiveWorkbook.Sheets("1 Öåíû êîíêóðåíòîâ Ìàñëà").Range("A9:AP78").Copy
Workbooks("Quarter brandmap macro_test.xlsm").Sheets("copied").Range("A" & i).PasteSpecial Paste:=xlValues
Workbooks("Quarter brandmap macro_test.xlsm").Sheets("copied").Range("A" & i).PasteSpecial Paste:=xlFormats
я добавила ваш код и странность.. он по 1му файлу, которого копировал заполнил имя файла на каждой строке. А вот по 2му почему только несколько первых, а остальные остались пустыми.
При этом, если я добавляю в папку с файлами еще один новый файл, то он выдает ошибку "Run-time error '1004'. Application-defined or object-defined error".
"Новый" файл точно такой же как предыдущее только с измененным названием файла
Изменено: Мария - - 19.08.2020 18:16:05
 
Можете файл приложить с полным кодом?
Мария -, Если ваш код записать вот так:

Код
Dim FSO As Object, ifile As Object
Dim lrow&
Set FSO = CreateObject("Scripting.FileSystemObject")
lrow = Range("aq" & Rows.Count).End(xlUp).Row + 1
For Each ifile In FSO.getFolder("C:\Users\......").Files
'        ....часть макроса с копированием строк
    Range("aq" & lrow).Value = ifile.Path      ' Записывает полный путь к файлу
    Range("aq" & lrow).Value = ifile.ShortName ' Записывает только имя файла
    lrow = lrow + 1
Next

Закомментируйте ту строку с записью данных которая вам не нужна
Изменено: Nordheim - 20.08.2020 15:00:12
"Все гениальное просто, а все простое гениально!!!"
Страницы: 1
Наверх