Page 2 of 3 FirstFirst 123 LastLast
Results 11 to 20 of 23

Thread: 20$ Export from outlook to Excel

  1. #11
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,401
    Rep Power
    10
    I'll try to get something in over the weekend.
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

  2. #12
    Member
    Join Date
    Dec 2012
    Posts
    43
    Rep Power
    0
    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 View Post
    I'll try to get something in over the weekend.

  3. #13
    Senior Member
    Join Date
    Jun 2012
    Posts
    337
    Rep Power
    12
    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

  4. #14
    Member
    Join Date
    Dec 2012
    Posts
    43
    Rep Power
    0
    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,
    Last edited by Excel Fox; 06-07-2013 at 03:53 PM. Reason: Quote Removed

  5. #15
    Member
    Join Date
    Dec 2012
    Posts
    43
    Rep Power
    0
    Administrator.

    any luck with my outlook code?

  6. #16
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,401
    Rep Power
    10
    Some luck, but not all that's needed. Will post something later tonight.
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

  7. #17
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,401
    Rep Power
    10
    Code:
    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
    The task completed date is always showing 1/1/4501

    When does this show something else?
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

  8. #18
    Member
    Join Date
    Dec 2012
    Posts
    43
    Rep Power
    0
    Quote Originally Posted by Excel Fox View Post
    The task completed date is always showing 1/1/4501

    When does this show something else?

    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

  9. #19
    Junior Member
    Join Date
    Mar 2013
    Posts
    20
    Rep Power
    0
    hi would like to give a try what exactly do you need?

  10. #20
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,401
    Rep Power
    10
    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.
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

Similar Threads

  1. Export data from Excel to Access Table (ADO) using VBA
    By Admin in forum Excel and VBA Tips and Tricks
    Replies: 4
    Last Post: 02-24-2015, 07:53 PM
  2. Export outlook emails to Excel code Error
    By jamilm in forum Outlook Help
    Replies: 2
    Last Post: 02-22-2013, 03:48 PM
  3. Replies: 1
    Last Post: 05-20-2012, 12:23 PM
  4. Replies: 7
    Last Post: 05-09-2012, 11:34 PM
  5. Replies: 3
    Last Post: 02-20-2012, 12:54 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •