Gurus,
i just came to know that excelfox also have even faster hirehelp developers.
i have posted a hirehelp at Outlook to export the detail of outlook email to excel
plase see if you can take this asap.
i would pay 20 USD
thanks.
Printable View
Gurus,
i just came to know that excelfox also have even faster hirehelp developers.
i have posted a hirehelp at Outlook to export the detail of outlook email to excel
plase see if you can take this asap.
i would pay 20 USD
thanks.
Not taking this up; open to others. But just wanted to know where exactly are you facing a problem? If it's slowness, did you try with a fresh new file?
the code requires some developing becuase currenlty it exports perfectly, also it is not slow. but it does not do what i need . i need the code to also measure the response time between each subject matter.
Quote:
Originally Posted by Excel Fox
OK. So can you post a sample of how the output should look like?
here is the sample output file https://skydrive.live.com/redir?resi...2BF29043E0!248
Quote:
Originally Posted by Excel Fox
Dear Administrator,
any luck with my project?
grateful if you could help on this.
thanks.
Dear Administrator,
if no developer is taking this. please delete this thread.
thanks.
Can be done. I will take this up. Need clarification on something. In your sample file, there are subject lines that start with RE: and FW:
If we take out these characters, your pivot table will look lot more clear and sensible. Can you do that, and then check if we can work on that data? Also, after you do that, can you put in the expected output (for a few samples).
Also, the original macro needs to pick the SMTP address of the sender.
Dear Administrator
i do not need the RE: and FW: please take those out.
please look into my post Sophisticated Chalange calculating business hours between two dates in Excel
the case numbers are basically each subjects for emails. that is basically what i need. that from outlook emails are exported (FW and RE can be disregarded) then for each email between time received and actions the working hours are calculated.
please see that post in mrexcel forum and let me know if more clarificatiion is needed.
your help is very much appreciated.
Quote:
Originally Posted by Excel Fox
hope you can figure out something this weekend for this outlook code which pending for too long ;)
I'll try to get something in over the weekend.
i am sorry to be nagging you on this, but i was wondering to know if there is any progress made on my code?
thanks.
Quote:
Originally Posted by Excel Fox
Here you are:
Code:Sub M_snb()
With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(6)
redim sn(.items.count,2)
j=0
for each it in .Items
sn(j,0)=it.To
sn(j,1)=it.subject
sn(j,2)=it.body
j=j+1
next
End With
thisworkbook.sheets(1).cells(1).resize(ubound(sn)+1,ubound(sn,2)+1)=sn
End Sub
Dear Snb,
your code does not do nothing. i believe that you did not understand what the requirement of my project was. currently the Administrator is working on it. so, please do not bother.
regards,
Administrator.
any luck with my outlook code?
Some luck, but not all that's needed. Will post something later tonight.
The task completed date is always showing 1/1/4501Code:Option Explicit
Sub ExportToExcelV2()
Dim appExcel As Excel.Application
Dim appOutlook As Outlook.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim strSheet As String
Dim strPath As String
Dim intRowCounter As Integer
Dim intColumnCounter As Integer
Dim msg As Outlook.MailItem
Dim nms As Outlook.Namespace
Dim FolderSelected As Outlook.MAPIFolder
Dim varSender As String
Dim itm As Object
Dim lngColIndex As Long
On Error GoTo ErrHandler
Set appExcel = Application 'CreateObject("Excel.Application")
Set appOutlook = GetObject(, "Outlook.Application")
appExcel.Application.Visible = True
Set wkb = ThisWorkbook
Set wks = wkb.Sheets("exported data")
appExcel.GoTo wks.Cells(1)
Set nms = appOutlook.GetNamespace("MAPI")
Do
Stop
Set FolderSelected = nms.PickFolder
'Handle potential errors with Select Folder dialog box.
If FolderSelected Is Nothing Then
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
GoTo JumpExit
ElseIf FolderSelected.DefaultItemType <> olMailItem Then
MsgBox "These are not Mail Items", vbOKOnly, "Error"
GoTo JumpExit
ElseIf FolderSelected.Items.Count = 0 Then
MsgBox "There are no mail messages to export", vbOKOnly, "Error"
GoTo JumpExit
End If
'Copy field items in mail folder.
intRowCounter = 1
lngColIndex = 1
wks.Cells(intRowCounter, lngColIndex).Resize(, 9).Value = Array("To", "From", "Subject", "Body", "Received", "Folder", "Category", "Flag Status", "Client")
intRowCounter = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row
For Each itm In FolderSelected.Items
intColumnCounter = 1
If TypeOf itm Is MailItem Then
Set msg = itm
intRowCounter = intRowCounter + 1: Set rng = wks.Cells(intRowCounter, intColumnCounter): rng.Value = msg.To
'============================================================
varSender = ResolveDisplayNameToSMTP(msg.SenderEmailAddress, appOutlook)
If varSender = vbNullString Then varSender = msg.SenderEmailAddress
'============================================================
wks.Cells(intRowCounter, 2).Resize(, 8).Value = Array(varSender, RemoveREFW(msg.Subject), Left(msg.Body, 50), msg.ReceivedTime, FolderSelected.Name, msg.Categories, msg.FlagStatus, "=ISNA(MATCH(RC[-7],NonClient,0))")
varSender = vbNullString
End If 'TypeOf
Next itm
Loop
JumpExit:
Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set msg = Nothing
Set nms = Nothing
Set FolderSelected = Nothing
Set itm = Nothing
Exit Sub
ErrHandler:
If Err.Number = 1004 Then
MsgBox strSheet & " doesn't exist", vbOKOnly, "Error"
Else
MsgBox Err.Number & "; Description: " & Err.Description & vbCrLf & msg.ReceivedTime & vbCrLf & msg.Subject, vbOKOnly, "Error"
End If
Err.Clear: On Error GoTo 0: On Error GoTo -1
GoTo JumpExit
End Sub
Function ResolveDisplayNameToSMTP(sFromName, objApp As Object)
Dim oRecip As Recipient
Dim oEU As ExchangeUser
Dim oEDL As ExchangeDistributionList
Set oRecip = objApp.Session.CreateRecipient(sFromName)
oRecip.Resolve
If oRecip.Resolved Then
Select Case oRecip.AddressEntry.AddressEntryUserType
Case OlAddressEntryUserType.olExchangeUserAddressEntry, OlAddressEntryUserType.olOutlookContactAddressEntry
Set oEU = oRecip.AddressEntry.GetExchangeUser
If Not (oEU Is Nothing) Then
ResolveDisplayNameToSMTP = oEU.PrimarySmtpAddress
End If
Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
Set oEDL = oRecip.AddressEntry.GetExchangeDistributionList
If Not (oEDL Is Nothing) Then
ResolveDisplayNameToSMTP = oEDL.PrimarySmtpAddress
End If
End Select
End If
End Function
Private Function RemoveREFW(str As String) As String
If Left$(UCase(str), 3) = "RE:" Or Left$(UCase(str), 3) = "FW:" Then
str = Trim$(Mid$(str, 4))
ElseIf Left(UCase(str), 4) = "FWD:" Then
str = Trim$(Mid$(str, 5))
End If
RemoveREFW = Trim$(Replace$(Replace$(Replace$(str, "RE:", "", , , vbTextCompare), "FW:", "", , , vbTextCompare), "FWD:", "", , , vbTextCompare))
End Function
Sub CreatePiv()
Dim pvc As PivotCache
Dim pvt As PivotTable
With ThisWorkbook
Application.DisplayAlerts = 0
On Error Resume Next
.Worksheets("Output").Delete
Err.Clear: On Error GoTo 0: On Error GoTo -1
Application.DisplayAlerts = 1
.Worksheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Output"
Set pvc = .PivotCaches.Create(SourceType:=xlDatabase, SourceData:=.Worksheets("Exported Data").Cells(1).CurrentRegion.Address(, , xlR1C1, True), Version:=xlPivotTableVersion12)
Set pvt = pvc.CreatePivotTable(TableDestination:="Output!R3C1", TableName:="PvtCustom", DefaultVersion:=xlPivotTableVersion12)
End With
With pvt.PivotFields("Subject")
.Orientation = xlRowField
.Position = 1
.Subtotals(1) = False
End With
With pvt.PivotFields("Received")
.Orientation = xlRowField
.Position = 2
.Subtotals(1) = False
End With
With pvt.PivotFields("From")
.Orientation = xlRowField
.Position = 3
.Subtotals(1) = False
End With
With pvt.PivotFields("Client")
.Orientation = xlRowField
.Position = 4
.Subtotals(1) = False
End With
With pvt.PivotFields("Flag Status")
.Orientation = xlRowField
.Position = 5
.Subtotals(1) = False
End With
With pvt
.InGridDropZones = True
.RowAxisLayout xlTabularRow
.ColumnGrand = False
.RowGrand = False
End With
End Sub
When does this show something else?
Quote:
Originally Posted by Excel Fox
Dear Administrator.
do not worry about the task completed date. you can remove that part entirely. all what matters is the received date .
you shall remove the code intColumnCounter = intColumnCounter + 1: Set rng = wks.Cells(intRowCounter, intColumnCounter): rng.Value = msg.TaskCompletedDate
hi would like to give a try what exactly do you need?
hi ashu1990, Jamil is already in interaction with me over email, and we are working it out. Anyway, if you want to try out out of interest, please go ahead. Everything is explained in the posts above.
Hi fox,
:peacesign:
just intersted to know new things jamil whats to export all inbox into a worksheet and map the difference between 2 replis is this the task.
did not know what exactly he wants after reading the posts too.
He basically wants to know
1. how much time is spent between reverting to mails
2. if there is no revert, how long has it been since the mail was received
Both the above should consider that the work shift is 9AM to 6PM, and weekdays and any other holidays should be excluded
That's It!
The solution has been provided to OP, and it has been accepted.
Yes, just to highlight in this forum and express my thanks to Administrator for the extra-ordinary solution. it made my life easy.
Quote:
Originally Posted by Excel Fox