Lấy nội dung tin nhắn trên điện thoại vào Excel (6 người xem)

[thungdols]

Em kiếm cái code của anh NDU.. áp dụng từ text sang file (*vmg) tin nhắn lấy từ điện thoại ra. Em muốn lấy tất cả các tin nhắn vào 1 file excell như file đính kèm. Mong mọi người giúp đỡ em.

 

[thungdols]

kuldokk bạn có thể giúp mình được không ? cám ơn bạn trước

 

[ndu96081631]

Em kiếm cái code của anh NDU.. áp dụng từ text sang file (*vmg) tin nhắn lấy từ điện thoại ra. Em muốn lấy tất cả các tin nhắn vào 1 file excell như file đính kèm. Mong mọi người giúp đỡ em.

trong file đã làm cả rồi, bạn còn muốn sao nữa?

 

[thungdols]

nhưng anh NDU ơi em chỉ muốn lấy dữ liệu như phần em tô mầu thôi. Đây hàm nó lây ca code của file *vmg vào:
BEGIN:VMSG
VERSION:1.1
X-IRMC-STATUS:
X-IRMC-BOX:INBOX
X-NOK-DT:20140830T110425Z
X-MESSAGE-TYPEELIVER
BEGIN:VCARD
VERSION:3.0
N:
TEL: 841635540883
END:VCARD
BEGIN:VENV
BEGIN:VBODY
Date:30.08.2014 11:04:25
20tr Xe 16M-0778 . Com Dua, cuu, bai 1
END:VBODY
END:VENV
END:VMSG
mà em chỉ muốn lây mỗi nội dung tin nhắn :"20tr Xe 16M-0778 . Com Dua, cuu, bai 1" thôi
anh giúp em nha anh NDU96081631

 

[thungdols]

Loại bỏ 14 dòng bên trên và 3 dòng bên dưới.chỉ lấy nội dung của tin nhắn thôi. Anh ndu nhé. Anh bỏ chút thơi gian vàng ngọc ra giúp đỡ em nhé.cam ơn anh

 

[ndu96081631]

Loại bỏ 14 dòng bên trên và 3 dòng bên dưới.chỉ lấy nội dung của tin nhắn thôi. Anh ndu nhé. Anh bỏ chút thơi gian vàng ngọc ra giúp đỡ em nhé.cam ơn anh

Đúng ra việc lấy nội dung text vào Excel chẳng phải chuyện khó khăn gì. Vấn đề là: ít ra bạn cũng nên gửi lên đây vài cái tin nhắn (5 tin chẳng hạn) và 1 file excel ghi kết quả mà bạn cần ---> Thế người ta mới nghiên cứu tổng quát được chứ

 

[thungdols]

em gửi lại file. Mong anh giúp em. Cám on anh NDU

 

[ndu96081631]

em gửi lại file. Mong anh giúp em. Cám on anh NDU

Chỉ là việc xử lý chuỗi thôi. Xem cấu trúc thì thấy rằng ta cần lấy chuỗi từ sau từ "Date:dd.mm.yyyy hh:mm:ss" và trước từ "END:"
Vậy tôi sửa lại Sub Main trong file của bạn thành thế này:

Option Explicit
Sub Main()
  Dim sFolder, aFile, fleItem, arr()
 [COLOR=#ff0000] Dim sContent As String, sSender As String[/COLOR]
  Dim n As Long, t As Double
  On Error Resume Next
  [COLOR=#ff0000]Sheet1.Range("A2:B10000").ClearContents[/COLOR]
  sFolder = CreateObject("Shell.Application").BrowseForFolder(0, "", 1).Self.Path
  t = Timer
  If TypeName(sFolder) = "String" Then
    aFile = GetFilesList(sFolder, "*.vmg", False)
    If IsArray(aFile) Then
      ReDim arr(1 To UBound(aFile) + 1, [COLOR=#ff0000]1 To 2[/COLOR])
      With CreateObject("Scripting.FileSystemObject")
        For Each fleItem In aFile
          n = n + 1
          [COLOR=#ff0000]sSender = CStr(fleItem)
          sSender = Mid(sSender, InStrRev(sSender, "\") + 1)
          sSender = Left(sSender, Len(sSender) - 4)
          arr(n, 1) = sSender[/COLOR]
          With .OpenTextFile(fleItem, 1, , -2)
           [COLOR=#ff0000] sContent = .ReadAll[/COLOR]
            .Close
          End With
          [COLOR=#ff0000]sContent = Mid(sContent, InStr(1, sContent, "Date:") + 24)
          sContent = Mid(sContent, 1, InStr(1, sContent, "END:") - 1)
          arr(n, 2) = Replace(sContent, vbLf, "")[/COLOR]
        Next
      End With
      With Sheet1.Range("A2").Resize(n, 2)
        .Value = arr
        .WrapText = True
      End With
      MsgBox "Tim thay " & n & " tin nhan", , "(" & Format(Timer - t, "0.000s") & ")"
    End If
  End If
End Sub

Những chỗ màu đỏ là chỗ sửa lại

 

[thungdols]

Em chân thành cám ơn anh NDU. nhưng em lại gặp phải 1 vấn đề khó nữa trong việc trích lọc dữ liệu. của các tin nhắn sang bảng tổng hợp. Anh thương em cho chót. giúp em chút xíu nha anh. cám ơn anh nhiều
p/s: em đính kèm ở trong file

 

[ndu96081631]

Em chân thành cám ơn anh NDU. nhưng em lại gặp phải 1 vấn đề khó nữa trong việc trích lọc dữ liệu. của các tin nhắn sang bảng tổng hợp. Anh thương em cho chót. giúp em chút xíu nha anh. cám ơn anh nhiều
p/s: em đính kèm ở trong file

Việc trích lọc dữ liệu này lại là vấn đề khác. Tốt nhất bạn nên mở topic khác để hỏi nhé
Cứ hỏi việc này lại nhân tiên hỏi ké chuyện khác, đến 1 thời gian sau chả ai biết chủ đề của topic là nói về cái gì nữa