PDA

View Full Version : Import Data To Excel Customer Service Worksheet



vidaLL
10-08-2013, 04:30 AM
Hello.
I'm head banging with a macro. My need is based on information from a spreadsheet of customer service, where we measured the response time.
I sketched something about the information I need. However I can not extract the date on which I replied.
I wish the macro to bring only the emails from Inbox that were answered (using the ConversationID, ConversationIndex) but i don't know how to make that link the Inbox with the Outbox


Sub fncRelatório()
'Execute esta macro no Outlook

'Altere o caminho abaixo
Const cstrOutput As String = "\Desktop\Relatorio.xls"

Dim intFF As Integer
Dim lngMonth As Long
Dim lngYear As Long
Dim Folders As Outlook.Folders
Dim mli As MailItem
Dim nms As NameSpace
Dim objAllItems As Outlook.Items
Dim objFilteredItems As Outlook.Items
Dim objItem As Object
Dim strCriteria As String
Dim xlsCriterio As String

lngYear = InputBox("Type the year:", , Year(Date))
lngMonth = InputBox("Type the month:", , Month(Date))


If lngYear < 1900 Or lngYear > 3000 Or lngMonth < 1 Or lngMonth > 12 Then
MsgBox "Wrong data.", vbCritical
Exit Sub
End If

Set nms = Application.GetNamespace("MAPI")
Set objAllItems = nms.Folders(Type your email here).Folders("Inbox").Items
strCriteria = "[ReceivedTime] > " & "'" & DateSerial(lngYear, lngMonth, 1) & "'" _
& " And [ReceivedTime] < " & "'" & DateSerial(lngYear, lngMonth + 1, 1) & "'"
Set objFilteredItems = objAllItems.Restrict(strCriteria)

intFF = FreeFile
Open "C:\Users\User\Desktop\Relatorio.xls" For Output As #intFF
For Each objItem In objFilteredItems
If TypeName(objItem) = "MailItem" Then
Set mli = objItem

'Print #intFF, "Teste:" & mli.LastModificationTime


xlsCriterio = "Issuer: " & mli.SenderName & "|" & "Received Time: " & mli.ReceivedTime & "|" & "Last Modification: " & mli.LastModificationTime & "|" & "Title: " & mli.Subject & "|"
'Print #intFF, "Corpo da Mensagem: " & Left(mli.Body, 80)


Print #intFF, xlsCriterio

End If
Next objItem
Close #intFF
End Sub


Thanks guys.