Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » Nik1980
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
работа с данными на веб ресурсе, получение данных из XML файлов расположенных на веб ресурсе
 
#
16.03.2023 12:52:16
Коллеги, добрый день.
Написал макрос, который просматривает все файлы 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
 
Перейти    
Создание примечаний к ячейке, функция создания примечаний на VBA
 
#
06.03.2023 11:17:51
Коллеги , добрый день.

Задался вопросом создания примечаний через функцию 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
 
Перейти    
Excel 2016 + Outlook 2016, автоматическая рассылка писем из Excel
 
#
02.03.2023 09:46:56
Коллеги, добрый день.
Попытался написать процедуру для автоматической рассылки писем из 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
 
Перейти    
VBA - получение значений из файлов по цвету ячейки, получение макросом значений ячеек из файлов по цвету заливки ячейки
 
#
27.09.2022 14:41:52
Коллеги, помогите пожалуйста разобраться ..
Пишу макрос, который
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
 
Перейти    
VBA. Рассчитать формулу из ячейки другого листа
 
#
07.12.2020 21:24:58
Парни, помогите  !   есть лист1 с формулами, например , А1 =  С1+B1  . как сделать так, чтобы на другом листе  можно было сослаться на эту формулу а не на значение в ячейке А1
то есть ссылаясь на эту ячейку на листе 2 ,например, я бы получил туже формулу С1+B1 . И при изменении формулы на листе 1 менялась бы формула и в ячейке на листе 2

Пробовал через пользовательскую функцию
Код
Public Function CopyF(r As Range) As Variant    
CopyF = r.Formula
End Function

но такая функция возвращает мне только формулу в текстовом формате, а сама формула не рассчитывается
я просто вижу = С1+B1
видимо нужно доработать функцию .. но как .. если кто знает, буду признателен .  
 
Перейти    
Будет ли работать ВПР если в ней сослаться на на пока несуществующий файл?, Не работает ВПР
 
#
12.02.2019 07:13:04
Проблема с ВПР..  Есть сводный файл в который я хочу с помощью ВПР подтянуть данные из других файлов, которые будут размещены в определённой папке на сетевом диске. Этих файлов пока не существует., т. е я пишу формулу ВПР с ссылкой на несуществующий файл. В самой формуле полностью прописываю адрес файла и его название с расширением.. Но когда эти файлы добавляю в папку данные не подтягиваются.. Пишет н#д.  При этом если вручную через обновить связи привязать конкретный файл все работает.. Проблема в том что этих файлов порядка 1000 и каждый вот так привязывать к своду физически нереально..  Кто нибудь сталкивался с такой проблемой?  Есть какое то решение.?  Путь и название файлов проверял  Ошибок нет..  Возможно  
 
Перейти    
[ Закрыто] ВПР, Не работает ВПР
 
#
11.02.2019 23:12:18
Проблема с ВПР..  Есть сводный файл в который я хочу с помощью ВПР подтянуть данные из других файлов, которые будут размещены в определённой папке на сетевом диске. Этих файлов пока не существует., т. е я пишу формулу ВПР с ссылкой на несуществующий файл. В самой формуле полностью прописываю адрес файла и его название с расширением.. Но когда эти файлы добавляю в папку данные не подтягиваются.. Пишет н#д.  При этом если вручную через обновить связи привязать конкретный файл все работает.. Проблема в том что этих файлов порядка 1000 и каждый вот так привязывать к своду физически нереально..  Кто нибудь сталкивался с такой проблемой?  Есть какое то решение.?  Путь и название файлов проверял  Ошибок нет..  
 
Перейти    
VBA открытие файла и копирование информации, копирование данных из файла в файл
 
#
11.02.2019 20:55:07
Коллеги, подскажите пожалуйста
думаю , проблема для тех соображает в макросах ,элементарно решается

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

т.е. нужен макрос, который откроет по очереди данные файлы , скопирует данные из нужной ячейки в сводный файл и закроет test1 и test2 без сохранения .
еще нужно, чтобы он как то игнорировал ошибку, в случае если файла test1 и (или) test2 нет в папке .. т.е. если нет test1 то переходил к копированию из test2 или завершал процедуру..,
может кто-нить краткий пример такого макроса скинуть ?  
 
Перейти    
Данные с WEB ресурса, выгрузка с Share Point
 
#
17.07.2018 15:16:18
Друзья , кто то делал выгрузку информации с файлов расположенных на веб ресурсах ?
как прописать название папки, в которой нужно обработать файлы ?
В этом макросе у меня ругается на   sFiles = Dir(sFolder & "*.xls*") . имя папки нашел через формулу =ЯЧЕЙКА("имяфайла")
Код
Sub Get_All_File_from_Folder1()
Dim sFolder As String, sFiles As String
   
   sFolder = "Веб сайты/https://sp.pp.ru/fin/DocLib19/Постоянные разницы (полугодие) от 17.07.2018/"
   'отключаем обновление экрана
   Application.ScreenUpdating = False
   sFiles = Dir(sFolder & "*.xls*")
   Do While sFiles <> ""
   Set importWB = Workbooks.Open(sFolder & sFiles)
   importWB.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
   ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = importWB.Name
   importWB.Close savechanges:=False

   sFiles = Dir
   Loop
   'возвращаем ранее отключенное обновление экрана
   Application.ScreenUpdating = True
End Sub
 
Перейти    
Макрос действия с файлами в выбранной папке
 
#
17.07.2018 11:21:09
Есть макрос, который выводит меню выбора файлов . С выбранными файлами производятся следующие действия:
из каждого файла копируется первый лист и вставляется в открытую книгу - скопированным листам в новой книге присваиваются имена файлов.

Помогите пожалуйста изменить макрос так, чтобы эти действия производились для всех файлов excel в выбранной папке  - т.е. чтобы можно было просто выбрать папку без выбора конкретных файлов.  
Код
Sub CombineanWBrenameSH()
    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 importWB = Workbooks.Open(Filename:=FilesToOpen(x))
        Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = importWB.Name
        importWB.Close savechanges:=False
        x = x + 1
    Wend
 
    Application.ScreenUpdating = True
End Sub
 
Перейти    
Импорт данных из интернета на новый лист в формате HTML, макрос
 
#
09.11.2015 11:05:42
Коллеги, очень нужен макрос по выгрузке данных из интернета !
Можете помочь ?
Суть проблемы :
есть лист, на котором есть список компаний с адресами их веб сайтов . сами адреса (url) расположены в отдельном столбце (например B) - в текстовом формате, (не гиперссылки).
Нужен код, который бы в случае наличия адреса в ячейке данного столбца делал бы соответствующий веб запрос и выгружал бы данные на новый лист в формате HTML,
если ячейка с адресом пустая переходил бы к следующей , которая расположена ниже, и так до тех пор пока не переберет все ячейке в столбце и не создаст соответствующее кол-во листов в информацией.
 
Перейти    
Страницы: 1
Наверх