не помогло..

да, спасибо !
подключил как сетевой диск ..но теперь при запуске спотыкается на For Each nd In .getElementsByTagName("НПЮЛ")

и выдает ошибку времени RunTime - "Данные, необходимые для выполнения этой операции, еще не доступны"

причем, при выполнении в режиме построчно все ОК (через F8)
можно как то исправить ?


Sub XML()

  Dim Sh As Worksheet
  Dim Folder As String
  Dim FileName As String
  Dim i As Long
  Dim nd
 

  Folder = "Z:\Тест НДС"
     
           i = 0
  FileName = Dir(Folder & "/", vbNormal)
  Do While FileName <> ""
 
      i = i + 1
     
      fl = ThisWorkbook.Path & "\" & FileName
  With CreateObject("MSXML2.DOMDocument")
      .Load fl
     
     
      For Each nd In .getElementsByTagName("НПЮЛ")
                         
            Cells(i + 1, 1) = nd.GetAttribute("НаимОрг")
            Cells(i + 1, 2) = nd.GetAttribute("ИННЮЛ")
            Cells(i + 1, 3) = nd.GetAttribute("КПП")

Коллеги, добрый день.
Написал макрос, который просматривает все файлы XML в определенной папке ( Z:\Тест НДС) и вставляет построчно нужные данные из XML файлов на лист Excel.  Все работает как надо .
Но сейчас выяснятся, что XML файлы будут храниться в библиотеке SharePoint , а это уже веб ресурс получается..
Как сделать так, чтобы просматривались файлы из библиотеки SharePoint ?  как получить значение Folder ?




Sub XML()

   Dim Sh As Worksheet
   Dim Folder As String
   Dim FileName As String
   Dim i As Long
   Dim nd
   
 
   Folder = "Z:\Тест НДС"
       
            i = 0
   FileName = Dir(Folder & "/", vbNormal)
   Do While FileName <> ""
   
       i = i + 1
       
       fl = ThisWorkbook.Path & "\" & FileName
   With CreateObject("MSXML2.DOMDocument")
       .Load fl
       
       
       For Each nd In .getElementsByTagName("НПЮЛ")
                           
             Cells(i + 1, 1) = nd.GetAttribute("НаимОрг")
             Cells(i + 1, 2) = nd.GetAttribute("ИННЮЛ")
             Cells(i + 1, 3) = nd.GetAttribute("КПП")
                       
           Next
       
        For Each nd In .getElementsByTagName("Документ")
                           
             Cells(i + 1, 4) = nd.GetAttribute("ОтчетГод")
             Cells(i + 1, 5) = nd.GetAttribute("Период")
             If Cells(i + 1, 5).Value = "24" Then
             Cells(i + 1, 5).Value = "4 квартал"
             End If
                                     
           Next
       
       
       For Each nd In .getElementsByTagName("СумУпл164")
             
             
           Cells(i + 1, 7) = nd.GetAttribute("НалПУ164")
           Cells(i + 1, 6) = Cells(i + 1, 7).Value / 3
       
 Next
 
     
 
   End With
   
       FileName = Dir
   Loop
         
         

End Sub

Спасибо ! то что нужно  

как я понял,  в моем случае эта проблема из за настроек безопасности Outlook  

Такая функция возвращает просто значение 0 в ячейку toCell.

Есть ,например, ячейка А1 с значением в виде текста (примечания в ней нет) , нужно чтобы в функции я указал эту ячейку в качестве аргумента FromCell и она создала мне в ячейке toCell комментарий с текстом содержащимся в ячейке А1  

я так пробовал, тоже самое только еще автор добавляется .

Коллеги , добрый день.

Задался вопросом создания примечаний через функцию VBA
toCell  указываем ячейку в которую нужно вставить примечания
FromCell - указываем ячейку из которой нужно получить текст для примечания
Вроде все работает .. но вместе с примечанием функция вставляет в ячейку еще и просто значение из ячейки FromCell
Может кто поможет это исправить ?

код
Function Text_to_Comment(FromCell As Range, toCell As Range)
On Error Resume Next
   toCell.Comment.Delete
   Text_to_Comment = toCell.AddComment.Text(FromCell.Value)
End Function

да , Display пробовал - все заполняет правильно , если вручную пошагово запускать . Но только если outlook уже открыт.  Если он перед запуском закрыт ничего не происходит , объект OutMail  не создается..  А что можно с Application.OnTime сделать ?  

в cell.Offset(0, 4).Value  моя учетная , подключенная к outlook  

Коллеги, добрый день.
Попытался написать процедуру для автоматической рассылки писем из Excel
по моей задумки должна работать при открытии файла..
Но почему то при выполнении .Send возникает ошибка runtime



Private Sub Workbook_Open()
   

   Dim OutApp As Object
   Dim OutMail As Object
   Dim cell As Range
   Dim rng As Range
   

   Set OutApp = CreateObject("Outlook.Application")
   
 
   Set rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
   

   For Each cell In rng
   
       If cell.Offset(0, 3).Value = Date Then
       
           Set OutMail = OutApp.CreateItem(0)
       
           With OutMail
               .To = cell.Value
               .Subject = cell.Offset(0, 1).Value
               .Body = cell.Offset(0, 2).Value
               .SentOnBehalfOfName = cell.Offset(0, 4).Value
              .Send
           End With
       End If
   Next cell
   

   Set OutMail = Nothing
   Set OutApp = Nothing
     
   ThisWorkbook.Close
   
End Sub

Вот пример работы вашего макроса с файлом 3Color .
Вы когда цикл писали ориентировались на ситуацию, при которой будет один файл и много закрашенных ячеек .
Но у меня будет 1000 файлов и в каждом файле будет только 3 закрашенных ячейки  (три цвета - три ячейки)

Вот результат работы моего макроса.

Наименование   файла ( wbname )	Налогоплательщик   ( n )	сумма по   регистру ( v )	Наименование регистра ( r )
Рога_и_Копыта_010_2_02   (XLSX).xlsx	Налогоплательщик:  ООО   "Рога и Копыта"	3 464 670 551,41	Регистр учета стоимости МПЗ, списанных в отчетном периоде
Рога_и_Копыта_010_2_02.01   (XLSX).xlsx	Налогоплательщик:  ООО   "Рога и Копыта"	8 545 248,26	Регистр учета прямых расходов на производство

Вот пример работы вашего макроса с моими двумя файлами - цвета сделал соответствующие моим Array(0, 0, 15921906, 65535, 15853276)

Наименование   файла ( wbname )	Налогоплательщик   ( n )	сумма по   регистру ( v )	Наименование регистра ( r )
Рога_и_Копыта_010_2_02   (XLSX).xlsx			Регистр учета стоимости МПЗ, списанных в отчетном периоде
Рога_и_Копыта_010_2_02   (XLSX).xlsx
Рога_и_Копыта_010_2_02   (XLSX).xlsx
Рога_и_Копыта_010_2_02   (XLSX).xlsx
Рога_и_Копыта_010_2_02   (XLSX).xlsx	Налогоплательщик:  ООО   "Рога и Копыта"
Рога_и_Копыта_010_2_02   (XLSX).xlsx
Рога_и_Копыта_010_2_02   (XLSX).xlsx		3 464 670 551,41
Рога_и_Копыта_010_2_02.01   (XLSX).xlsx			Регистр учета прямых расходов на производство
Рога_и_Копыта_010_2_02.01   (XLSX).xlsx
Рога_и_Копыта_010_2_02.01   (XLSX).xlsx
Рога_и_Копыта_010_2_02.01   (XLSX).xlsx
Рога_и_Копыта_010_2_02.01   (XLSX).xlsx	Налогоплательщик:  ООО   "Рога и Копыта"
Рога_и_Копыта_010_2_02.01   (XLSX).xlsx
Рога_и_Копыта_010_2_02.01   (XLSX).xlsx
Рога_и_Копыта_010_2_02.01   (XLSX).xlsx		8 545 248,26

Спасибо! .. я понял )  добавил  выход   Exit For
теперь все работает

For Each cell In Range("A1:N5000")
       If cell.Interior.Color = 15853276 Then
       r = cell.Value
       ThisWorkbook.Sheets("Лист1").Cells(x + 1, 4).Value = r
       Exit For

Добрый день. Нет данные подтягиваются некорректно . Примеры подгрузил выше - ваш макрос в модуле 2  (файл Регистры)

Вот пример
Файл Регистры - это файл сбора информации (Нужный макрос в модуле 3 - активируется при нажатии кнопки Заполнить данные из регистров
после запуска макроса выбираем два файла Рога и Копыта . из них на лист 1 в столбцы 1-4 файла Регистры должны подтянуться необходимые данные, закрашенные 65535, 15921906, 15853276 .  Данные закрашенные 15853276 .не подтягиваются. Цвет верный поскольку если например этот цвет поменять местами с другими то данные подтягиваются
 

Может пример прислать .. ?  

Спасибо !, но ваш код работает некорректно - данные располагаются на листе в разнобой , последовательность не соблюдается.  

Вот пример работы моего кода - для примера указал в шапке столбцов наименование переменных из кода.
Проблема с наименованием регистра - в моем коде это переменная r .  В  открываемых файлах эти ячейки закрашены 16247773, но значения переменной не присваиваются

Наименование   файла ( wbname )	Налогоплательщик   ( n )	сумма по   регистру ( v )	Наименование регистра ( r )
ТП_Рязань_010_2_02   (XLSX).xlsx	Налогоплательщик:  ООО   "Рога и копыта"	3 464 670 551,41
ТП_Рязань_010_2_02.01   (XLSX).xlsx	Налогоплательщик:  ООО   "Рога и копыта"	8 545 248,26
ТП_Рязань_010_2_02_ПФ   (XLSX).xlsx	Налогоплательщик:  ООО   "Рога и копыта"	100 000,00
ТП_Рязань_011_1_02 (XLSX).xlsx	Налогоплательщик:  ООО   "Рога и копыта"	3 986 598 413,45

Да, спасибо !  сейчас открытые файлы закрываются.. но почему у переменной r нет значения не понимаю ..  ячейки закрашенные 16247773 есть , а значений у переменной нет..  

Коллеги, помогите пожалуйста разобраться ..
Пишу макрос, который
1) открывает файлы excel через диалоговое окно
2) вставляет название этих файлов в столбец 1 на лист 1 рабочей книги,
3) при условии, если ячейки в этих файлах залиты определенным цветом, значение этих ячеек последовательно вставляет на лист 1 рабочей книги в разные столбцы (2,3,4)
4) закрывает открытые файлы

Всего у меня в есть ячейки закрашенные тремя цветами .
Код работает нормально для двух цветов 65535 и 15921906 , при попытке добавить цикл  по третьему цвету 16247773 код начинает работать некорректно
- не закрывает открытые файлы и вставляет в столбец 4 значение ячеек с цветом 16247773,
при проверки кода построчно значение переменной r = emty ..

Код макроса всего привожу ниже,  часть кода, который я добавляю для цвета 16247773 выделил красным , если его убрать все работает нормально..
Не могу понять в чем ошибка .. полагаю что то не так с циклом For


Sub CombineanWBrenameSH1()
   Dim FilesToOpen
   Dim x As Integer

   Application.ScreenUpdating = False  
   
   
   FilesToOpen = Application.GetOpenFilename _
     (FileFilter:="All files (*.*), *.*", _
     MultiSelect:=True, Title:="Files to Merge")

   If TypeName(FilesToOpen) = "Boolean" Then
       MsgBox "не выбрано ни одного файла!"
       Exit Sub
   End If
   
 
   x = 1
   While x <= UBound(FilesToOpen)
       Set c = Workbooks.Open(Filename:=FilesToOpen(x))
          wbname = c.Name
           ThisWorkbook.Sheets("Лист1").Cells(x + 1, 1).Value = wbname
       For Each cell In Range("A1:N5000")
          If cell.Interior.Color = 65535 Then
            v = cell.Value
              ThisWorkbook.Sheets("Лист1").Cells(x + 1, 3).Value = v
       Exit For
       End If
       Next
         For Each cell In Range("A1:N5000")
           If cell.Interior.Color = 15921906 Then
             n = cell.Value
               ThisWorkbook.Sheets("Лист1").Cells(x + 1, 2).Value = n
      Exit For
       End If
       Next
         For Each cell In Range("A1:N5000")
          If cell.Interior.Color = 16247773 Then
           r = cell.Value
            ThisWorkbook.Sheets("Лист1").Cells(x + 1, 4).Value = r
              c.Close savechanges:=False
       
       
       End If
       Next
       x = x + 1
       
   Wend

   Application.ScreenUpdating = True

беда в том, что это не я придумал ) начальству для какого то отчета это понадобилось.. я и сам понимаю , что это какой то геммор.. причем бессмысленный .. но желание так сказать выслужиться перевесило ))) подумал может тут  кто то  знает как поступить. - моя функция возвращает по сути текст формулы ..его нужно только в формулу опять превратить )

Как этот код использовать.. не понимаю 😒

Парни, помогите  !   есть лист1 с формулами, например , А1 =  С1+B1  . как сделать так, чтобы на другом листе  можно было сослаться на эту формулу а не на значение в ячейке А1
то есть ссылаясь на эту ячейку на листе 2 ,например, я бы получил туже формулу С1+B1 . И при изменении формулы на листе 1 менялась бы формула и в ячейке на листе 2

Пробовал через пользовательскую функцию

но такая функция возвращает мне только формулу в текстовом формате, а сама формула не рассчитывается
я просто вижу = С1+B1
видимо нужно доработать функцию .. но как .. если кто знает, буду признателен .  

Согласен что идея не очень. Но тут либо так, либо макрос писать..  

Индекс(поискпоз) работает. Данные обновляются. Значит проблема действительно в ВПР.

Спасибо. Попробую через индекс.. Согласен что идея не очень. Но тут либо так, либо макрос писать..  

Проблема с ВПР..  Есть сводный файл в который я хочу с помощью ВПР подтянуть данные из других файлов, которые будут размещены в определённой папке на сетевом диске. Этих файлов пока не существует., т. е я пишу формулу ВПР с ссылкой на несуществующий файл. В самой формуле полностью прописываю адрес файла и его название с расширением.. Но когда эти файлы добавляю в папку данные не подтягиваются.. Пишет н#д.  При этом если вручную через обновить связи привязать конкретный файл все работает.. Проблема в том что этих файлов порядка 1000 и каждый вот так привязывать к своду физически нереально..  Кто нибудь сталкивался с такой проблемой?  Есть какое то решение.?  Путь и название файлов проверял  Ошибок нет..  Возможно  

Проблема с ВПР..  Есть сводный файл в который я хочу с помощью ВПР подтянуть данные из других файлов, которые будут размещены в определённой папке на сетевом диске. Этих файлов пока не существует., т. е я пишу формулу ВПР с ссылкой на несуществующий файл. В самой формуле полностью прописываю адрес файла и его название с расширением.. Но когда эти файлы добавляю в папку данные не подтягиваются.. Пишет н#д.  При этом если вручную через обновить связи привязать конкретный файл все работает.. Проблема в том что этих файлов порядка 1000 и каждый вот так привязывать к своду физически нереально..  Кто нибудь сталкивался с такой проблемой?  Есть какое то решение.?  Путь и название файлов проверял  Ошибок нет..  

Спасибо. Да это вариант. только с ошибкой как быть не знаю.. я имею ввиду,как сделать так чтобы макрос игнорировал отсутствие какого либо  файла и переходил к следующему..  

Коллеги, подскажите пожалуйста
думаю , проблема для тех соображает в макросах ,элементарно решается

есть сводный файл - в него необходимо скопировать данные ,например, из 2 файлов .- расположение и имя этих файлов я знаю (оно всегда одинаково)  
имена этих файлов  например test1, test2  
Данные из test1, test2 необходимо скопировать в ячейку А1 и А2 сводного файла
нужные данные в test1 содержатся в последней заполненной ячейке столбца 4 ,
а данные в test 2 содержатся в последней заполненной ячейки столбца 5

т.е. нужен макрос, который откроет по очереди данные файлы , скопирует данные из нужной ячейки в сводный файл и закроет test1 и test2 без сохранения .
еще нужно, чтобы он как то игнорировал ошибку, в случае если файла test1 и (или) test2 нет в папке .. т.е. если нет test1 то переходил к копированию из test2 или завершал процедуру..,
может кто-нить краткий пример такого макроса скинуть ?  

Друзья , кто то делал выгрузку информации с файлов расположенных на веб ресурсах ?
как прописать название папки, в которой нужно обработать файлы ?
В этом макросе у меня ругается на   sFiles = Dir(sFolder & "*.xls*") . имя папки нашел через формулу =ЯЧЕЙКА("имяфайла")