Adapte o exemplo abaixo. Modo de usar: abra um e-mail do Outlook e em seguida execute esta macro.
Dim mmli As MailItem
Sub fncExport2Excel()
Dim inp As Inspector
Dim appExcel As Object
Dim wks As Object
Set mmli = Nothing
On Error Resume Next
Set mmli = ActiveInspector.CurrentItem
If mmli Is Nothing Then
MsgBox "Abra o e-mail que deseja extrair os dados.", vbCritical
GoTo Fim
End If
Set appExcel = GetObject(, "Excel.Application")
On Error GoTo 0
If appExcel Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
End If
appExcel.Visible = True
Set wks = appExcel.Workbooks.Add.Worksheets(1)
wks.Range("A1") = fncGetInfo("Nome: ")
wks.Range("A2") = fncGetInfo("Rg: ")
wks.Range("A3") = fncGetInfo("CPF: ")
wks.Range("A4") = fncGetInfo("END: ")
Fim:
End Sub
Function fncGetInfo(str As String) As String
Dim lngStart As Long
Dim lngEnd As Long
Dim strBody As String
strBody = mmli.Body
lngStart = InStr(strBody, str)
lngEnd = InStr(lngStart + 1, strBody, vbNewLine)
fncGetInfo = Mid(strBody, lngStart, lngEnd - lngStart + 1)
End Function
Felipe Costa Gualberto - http://www.ambienteoffice.com.br
