Как создать архив вайбер со смартфона.
1) создаем копию в zip со смартфона:
чтобы открыть, посмотреть, почитать сохраненную переписку, то Viber предоставляет нам такую возможность. Но это будет просто архив с названием Viber.zip, внутри которого вы найдете множество отдельных файлов с расширением .csv по количеству ваших собеседников в этом мессенджере.
2) переносим на компьютер файл
viber.zip
3) разархивируем.
4) открываем эксель, создаем новый файл, записываем новый макрос в модуль:
Sub CombineWorkbooks()
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().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
importWB.Close savechanges:=False
x = x + 1
Wend
Application.ScreenUpdating = True
End Sub
запускаем модуль, собираем все файлы в один файл (но разные листы в одной книге)
https://toster.ru/q/197267
4) все переписки перенеслись в разные листы. Чтобы переместить в один лист создаем новый макрос:
https://www.excel-vba.ru/chto-umeet-excel/kak-sobrat-dannye-s-neskolkix-listov-ili-knig/
1) создаем копию в zip со смартфона:
Как скачать историю на компьютер и посмотреть переписку
чтобы открыть, посмотреть, почитать сохраненную переписку, то Viber предоставляет нам такую возможность. Но это будет просто архив с названием Viber.zip, внутри которого вы найдете множество отдельных файлов с расширением .csv по количеству ваших собеседников в этом мессенджере.
Название каждого документа внутри архива будет соответствовать названию контакта, поэтому разобраться, где кто есть, будет не сложно.
Естественно, что там будет только текстовая информация, а вместо фото или видео так и будет написано: фото или видео.
Естественно, что там будет только текстовая информация, а вместо фото или видео так и будет написано: фото или видео.
Если при сохранении архива на компьютер вы получили «нечто» с непонятным значком, то просто добавьте .zip и операционная система его определит.
Но вот использовать такой файл для полноценного восстановления нельзя ни на смартфоне, ни на стационарном компьютере или ноутбуке.
Для сохранения действуем так:
Меню Viber в левом верхнем углу на телефоне => Настройки => Вызовы и сообщения => Отправить историю сообщений
Создается резервный файл и предлагается выбор, куда можно отправить или сохранить его:
Меню Viber в левом верхнем углу на телефоне => Настройки => Вызовы и сообщения => Отправить историю сообщений
Создается резервный файл и предлагается выбор, куда можно отправить или сохранить его:
Для восстановления мы можем использовать, как было сказано выше, только файл на Гугл диске, который перед этим сохранили.
2) переносим на компьютер файл
viber.zip
3) разархивируем.
4) открываем эксель, создаем новый файл, записываем новый макрос в модуль:
Sub CombineWorkbooks()
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().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
importWB.Close savechanges:=False
x = x + 1
Wend
Application.ScreenUpdating = True
End Sub
запускаем модуль, собираем все файлы в один файл (но разные листы в одной книге)
https://toster.ru/q/197267
4) все переписки перенеслись в разные листы. Чтобы переместить в один лист создаем новый макрос:
https://www.excel-vba.ru/chto-umeet-excel/kak-sobrat-dannye-s-neskolkix-listov-ili-knig/
'--------------------------------------------------------------------------------------- ' Module : mConsolidated ' DateTime : 02.02.2010 17:06 ' Author : The_Prist(Щербаков Дмитрий) ' Purpose : http://www.excel-vba.ru/chto-umeet-excel/kak-sobrat-dannye-s-neskolkix-listov-ili-knig/ ' Процедура сбора данных с нескольки листов/книг '--------------------------------------------------------------------------------------- Option Explicit Sub Consolidated_Range_of_Books_and_Sheets() Dim iBeginRange As Range, rCopy As Range, lCalc As Long, lCol As Long Dim oAwb As String, sCopyAddress As String, sSheetName As String Dim lLastrow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer Dim wsSh As Worksheet, wsDataSheet As Worksheet, bPolyBooks As Boolean, avFiles Dim wbAct As Workbook Dim bPasteValues As Boolean On Error Resume Next 'Выбираем диапазон выборки с книг Set iBeginRange = Application.InputBox("Выберите диапазон сбора данных." & vbCrLf & _ "1. При выборе только одной ячейки данные будут собраны со всех листов начиная с этой ячейки. " & _ vbCrLf & "2. При выделении нескольких ячеек данные будут собраны только с указанного диапазона всех листов.", Type:=8) 'для указания диапазона без диалогового окна: 'Set iBeginRange = Range("A1:A10") 'диапазон указывается нужный 'Если диапазон не выбран - завершаем процедуру If iBeginRange Is Nothing Then Exit Sub 'Указываем имя листа 'Допустимо указывать в имени листа символы подставки ? и *. 'Если указать только * то данные будут собираться со всех листов sSheetName = InputBox("Введите имя листа, с которого собирать данные(если не указан, то данные собираются со всех листов)", "Параметр") 'Если имя листа не указано - данные будут собраны со вех листов If sSheetName = "" Then sSheetName = "*" On Error GoTo 0 'Запрос - вставлять на результирующий лист все данные 'или только значения ячеек (без формул и форматов) bPasteValues = (MsgBox("Вставлять только значения?", vbQuestion + vbYesNo, "Excel-VBA") = vbYes) 'Запрос сбора данных с книг(если Нет - то сбор идет с активной книги) If MsgBox("Собрать данные с нескольких книг?", vbInformation + vbYesNo, "Excel-VBA") = vbYes Then avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True) If VarType(avFiles) = vbBoolean Then Exit Sub bPolyBooks = True lCol = 1 Else avFiles = Array(ThisWorkbook.FullName) End If 'отключаем обновление экрана, автопересчет формул и отслеживание событий 'для скорости выполнения кода и для избежания ошибок, если в книгах есть иные коды With Application lCalc = .Calculation .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual End With 'создаем новый лист в книге для сбора Set wsDataSheet = ActiveWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)) 'если нужно сделать сбор данных на новый лист книги с кодом 'Set wsDataSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) 'цикл по книгам For li = LBound(avFiles) To UBound(avFiles) If bPolyBooks Then Set wbAct = Workbooks.Open(Filename:=avFiles(li)) Else Set wbAct = ThisWorkbook End If oAwb = wbAct.Name 'цикл по листам For Each wsSh In wbAct.Worksheets If wsSh.Name Like sSheetName Then 'Если имя листа совпадает с именем листа, в который собираем данные 'и сбор идет только с активной книги - то переходим к следующему листу If wsSh.Name = wsDataSheet.Name And bPolyBooks = False Then GoTo NEXT_ With wsSh Select Case iBeginRange.Count Case 1 'собираем данные начиная с указанной ячейки и до конца данных lLastrow = .Cells(1, 1).SpecialCells(xlLastCell).Row iLastColumn = .Cells.SpecialCells(xlLastCell).Column sCopyAddress = .Range(.Cells(iBeginRange.Row, iBeginRange.Column), .Cells(lLastrow, iLastColumn)).Address Case Else 'собираем данные с фиксированного диапазона sCopyAddress = iBeginRange.Address End Select lLastRowMyBook = wsDataSheet.Cells.SpecialCells(xlLastCell).Row + 1 'определяем для копирования диапазон только заполненных данных на листе Set rCopy = Intersect(.Range(sCopyAddress).Parent.UsedRange, .Range(sCopyAddress)) 'вставляем имя книги, с которой собраны данные If lCol Then wsDataSheet.Cells(lLastRowMyBook, 1).Resize(rCopy.Rows.Count).Value = oAwb 'если вставляем только значения и форматы ячеек If bPasteValues Then rCopy.Copy wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol).PasteSpecial xlPasteValues wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol).PasteSpecial xlPasteFormats Else 'если вставляем все данные ячеек(значения, формулы, форматы и т.д.) rCopy.Copy wsDataSheet.Cells(lLastRowMyBook, 1).Offset(, lCol) End If End With End If NEXT_: Next wsSh If bPolyBooks Then wbAct.Close False Next li With Application .ScreenUpdating = True: .EnableEvents = True: .Calculation = lCalc End With End Sub
потом запускаем его, на новом листе выделяем одну ячейку, потом ок ок, и он соберет все на один лист.
потом можно пересохранить только один лист.
