Страницы: 1
RSS
сихронизация данных с смартфона на сетевой ресурс
 
Добрый день, форумчане! Вопрос такой: курьеры ежемесячно на мобильник снимают показания счетчиков потребления электроэнергии на объектах и отправляют фотографии с показаниями по whatsapp. Есть идея наладить процесс так ,чтобы курьеры помимо фотографии заполняли каждый свой еxcel-файл на мобильнике и эти данные автоматом подтягивались в общий сетевой файл. Подскажите как можно реализовать идею. Рабочие файлы прилагаю.
 
Мар Мухтарбек, добрый день! Вариант ( см. файл). Во вложении папка с файлами курьеров и файл с макросом. Запускаете в файле макрос по Alt+F8 и все :)
Код
Sub Select_data()
Dim mySQL As String, myConnect As String, myRecord As Object
Dim oFolder As String, oFile As String, lRow As Long, FSO As FileDialog, j As Long

Set myRecord = CreateObject("ADODB.Recordset")
Set FSO = Application.FileDialog(msoFileDialogFolderPicker)
With FSO
    .AllowMultiSelect = False
    .Show
    oFolder = .SelectedItems(1)
End With
oFile = Dir(oFolder & "\*.xls*")
While Len(oFile) > 0
    myConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source =" & oFolder & "\" & oFile & ";" & _
                "Extended Properties=""Excel 12.0;HDR=NO;"""
    mySQL = "SELECT * FROM [Лист1$] as t WHERE IsNumeric([F1]) AND [F2] IS NOT NULL"
    myRecord.Open mySQL, myConnect

    With Worksheets(1)
        lRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        .Cells(lRow + 1, 1).CopyFromRecordset myRecord
    End With
    myRecord.Close
    oFile = Dir
Wend
Set myRecord = Nothing
' нумерация
With Worksheets(1)
    For j = 1 To lRow + 1
        .Cells(j + 2, 1) = j
    Next j
End With
End Sub
 
Здравствуйте, artemkau88 . Отличная работа.Но мне надо чтобы обновлялась только часть с показаниями по месяцам. Т.е будет база данных в сетевом файле и надо чтобы она обновлялась показаниями с файлов курьером. см. рисунок
Изменено: Мар Мухтарбек - 02.10.2022 21:10:00
 
Мар Мухтарбек, можете объяснить, по какому критерию будет происходить сравнение данных  таблиц курьеров с итоговой таблицей (куда грузим данные)? По всем столбцам из левой части данных на скриншоте или как-то иначе?
Изменено: artemkau88 - 03.10.2022 08:15:28
 
del
Изменено: Ігор Гончаренко - 03.10.2022 10:55:53
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко delite
Изменено: Мар Мухтарбек - 03.10.2022 15:59:57
 
Цитата
написал:
Мар Мухтарбек , можете объяснить, по какому критерию будет происходить сравнение данных  таблиц курьеров с итоговой таблицей (куда грузим данные)? По всем столбцам из левой части данных на скриншоте или как-то иначе?
artemkau88, данные курьеров грузим в левую часть итоговой таблицы (в сетевой файл)  
 
Мар Мухтарбек, так макрос так и работает
 
artemkau88 макрос каждый раз грузит все данные с файла курьеров, а надо только левую часть с обновленными данными.  
 
Мар Мухтарбек, исправил, см. файл
Код
Sub Select_data()
Dim mySQL As String, myConnect As String, myRecord As Object
Dim oFolder As String, oFile As String, lRow As Long, FSO As FileDialog, j As Long

Set myRecord = CreateObject("ADODB.Recordset")
Set FSO = Application.FileDialog(msoFileDialogFolderPicker)
With FSO
    .AllowMultiSelect = False
    .Show
    oFolder = .SelectedItems(1)
End With
oFile = Dir(oFolder & "\*.xls*")
While Len(oFile) > 0
    myConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source =" & oFolder & "\" & oFile & ";" & _
                "Extended Properties=""Excel 12.0;HDR=NO;"""
    mySQL = "SELECT [F2], [F3], [F4], [F5], [F6], [F7], [F8], [F9] " & _
    "FROM [Лист1$] as t WHERE IsNumeric([F1]) AND [F2] IS NOT NULL"
    myRecord.Open mySQL, myConnect

    With Worksheets(1)
        lRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        .Cells(lRow + 1, 2).CopyFromRecordset myRecord
    End With
    myRecord.Close
    oFile = Dir
Wend
Set myRecord = Nothing
' нумерация
With Worksheets(1)
    For j = 1 To lRow + 1
        .Cells(j + 2, 1) = j
    Next j
End With
End Sub
 
Артем, извините я Вас совсем запутала  :oops: . Надо только правую часть с обновленными данными.  Буду признательна если добьете процесс.  
 
Мар Мухтарбек, проверяйте  :) . Вместо пустых значений подставляются 0
Изменено: artemkau88 - 04.10.2022 07:48:05
 
artemkau88 , Огромное спасибо   :)  в первую очередь за терпение. Вы буквально меня спасли.  
 
Мар Мухтарбек, пожалуйста! Успехов!  :)

P.S.
Изменил немного код в #12 сообщении. Теперь вставляются числовые значения.
Изменено: artemkau88 - 04.10.2022 07:48:59
 
Цитата
написал:
Мар Мухтарбек , пожалуйста! Успехов!  

P.S.
Изменил немного код в #12 сообщении. Теперь вставляются числовые значения.
Теперь вообще отлично стало ! И Вам успехов!  
 
Спасибо! :)  
Страницы: 1
Наверх