Consulting

Results 1 to 8 of 8

Thread: export mails to excel report

  1. #1

    Question export mails to excel report

    Hi Dear Experts, Hope all of doing safe and sound!


    well, I'm having a serious case that I'm getting lots of mails from various clients and I need to find a way to filter a a specific client mails and export them to excel report with defined criteria.


    so I will be pleased if someone can help me. i'm using outlook 2016


    I want to go through all mails at specific inbox, then target mails with specific sender. then define the duration period for target mail (for ex. from 10 jan to 15 jan 2021)


    all mails subjects will be as following:

    New :: [#85236951] New Task Proposal COVID EN-US :: WO42633 :: New Work Request :: Matrix Medical Network

    I need to export those subjects as exited on excel sheet attached.

    Sample.jpg

    I will be so much appreciated if some one can help me about this.

    Cheers


    cross-Posting link: https://www.excelforum.com/outlook-p...ter-mails.html
    Attached Files Attached Files

  2. #2
    The only tricky bit is the extraction of the data strings from the subject, but based on your example, the following should work, Note the from/to dates are in the format YYYMMDD and you will need to change the path and the sender e-mail as appropriate.

    Option Explicit
    
    Sub subject2excel()
    'Graham Mayor - https://www.gmayor.com - Last updated - 19 Jan 2021
    Dim olFolder As Outlook.Folder
    Dim olItem As MailItem    'Object
    Dim i As Long, j As Long, k As Long
    Dim vSubject As Variant, vLanguage As Variant
    Dim sType As String
    Dim lNumber As Long
    Dim sSubject As String, sLanguage As String, sD1 As String, sD2 As String, sD3 As String
    Dim strValues As String
    Dim lFrom As Long, lTo As Long
    Dim lDate As Long
    
    
    Const strSender As String = "someone@somewhere.com"   'insert sender
    Const sWorkbook As String = "C:\Path\Report.xlsx"    ' the location of the workbook
        
        'date range
        lFrom = 20210110: lTo = 20210115
    
    
        Set olFolder = Session.PickFolder
        For i = 1 To olFolder.items.Count
            Set olItem = olFolder.items(i)
            If olItem.SenderEmailAddress = strSender Then
                lDate = Val(Format(olItem.ReceivedTime, "yyyymmdd"))
                'Debug.Print lDate
                If lDate >= lFrom And lDate <= lTo Then
                    vSubject = Split(olItem.Subject, "::")
                    If UBound(vSubject) = 4 Then
                        For j = 0 To UBound(vSubject)
                            Select Case j
                                Case 0: sType = vSubject(j)
                                Case 1
                                    lNumber = Replace(Split(vSubject(j), "]")(0), "[#", "")
                                    sLanguage = Trim(Right(vSubject(j), 6))
                                    sSubject = Trim(Split(vSubject(j), "]")(1))
                                    sSubject = Left(sSubject, Len(sSubject) - 8)
                                Case 2: sD1 = vSubject(j)
                                Case 3: sD2 = vSubject(j)
                                Case 4: sD3 = vSubject(j)
                            End Select
                        Next j
                        strValues = sType & "', '" & _
                                    lNumber & "', '" & _
                                    sSubject & "', '" & _
                                    sLanguage & "', '" & _
                                    sD1 & "', '" & _
                                    sD2 & "', '" & _
                                    sD3
                        WriteToWorksheet sWorkbook, "Sheet1", strValues
                        DoEvents
                    End If
                End If
            End If
        Next i
    lbl_Exit:
        Set olFolder = Nothing
        Set olItem = Nothing
        Exit Sub
    End Sub
    
    
    Private Function WriteToWorksheet(strWorkbook As String, _
                                      strRange As String, _
                                      strValues As String)
    Dim ConnectionString As String
    Dim strSQL As String
    Dim CN As Object
        
        ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                           "Data Source=" & strWorkbook & ";" & _
                           "Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
        strSQL = "INSERT INTO [" & strRange & "$] VALUES('" & strValues & "')"
        Set CN = CreateObject("ADODB.Connection")
        Call CN.Open(ConnectionString)
        Call CN.Execute(strSQL, , 1 Or 128)
        CN.Close
        Set CN = Nothing
    lbl_Exit:
        Exit Function
    End Function
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Dear Graham, Many thanks for your generous help

    Please note that i got this error message while trying to execute the code!

    Untitled.png

  4. #4
    The original Report.xlsx worksheet attachment has the sheet named as "Sheet1" which is what the error message is referring to. Have you changed the sheet name?
    If so change the line WriteToWorksheet sWorkbook, "Sheet1", strValues to reflect the change.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    Hi Graham,

    Please note that i didn't change the worksheet name, as i only ran the code and got the message
    but i noticed that while the code is running there is a worksheet created at the path i defined and as i'm leaving the error message with no response i'm notified that this excel is used by another user and marked as read only

    1.jpg


    when i open it see that is name is changed

    2.jpg

    after i closed the error message at outlook VBA i found the excel disappears, and even i changed the sheet name at the code like on the excel (A266FF2A662E84b639DA) it doesn't work also!!

  6. #6
    The code as written does not create a worksheet. It uses "Sheet1" of the existing workbook defined at
    Const sWorkbook As String = "C:\Path\Report.xlsx"    ' the location of the workbook
    and was created to use the sample workbook that you supplied. This should be on the local hard drive.

    The workbook is not opened in order to write to it, but uses Microsoft.ACE.OLEDB.12.0 to write directly to it. In fact it shouldn't matter whether the workbook is open or closed in Excel. What would affect it is if you have another copy of the file open in Excel.

    Put your attachment in a new folder "C:\Path" without changing anything
    in the code, except the e-mail address to look for, and try it again.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    aha I got your point and yes it works well now after i already created defined excel file at a specific path, but sorry again i got this message and not all mails exported at the file

    1.png

    sorry again for bothering you

  8. #8
    Thanks a lot Graham for your generous cooperation and efforts. it is solved now

Tags for this Thread

Posting Permissions

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