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.

Attachment 27755

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

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.

Code:

---

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

---

Dear Graham, Many thanks for your generous help

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

Attachment 27773

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.

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

Attachment 27775


when i open it see that is name is changed

Attachment 27776

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!!

The code as written does not create a worksheet. It uses "Sheet1" of the existing workbook defined at

Code:

---

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.

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

Attachment 27777

sorry again for bothering you

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