PDA

View Full Version : [SOLVED:] export mails to excel report



Edgar5155
01-19-2021, 12:05 AM
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.

27755

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

Cheers


cross-Posting link: https://www.excelforum.com/outlook-programming-vba-macros/1338256-outlook-macro-to-filter-mails.html

gmayor
01-19-2021, 09:39 PM
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

Edgar5155
01-21-2021, 01:02 AM
Dear Graham, Many thanks for your generous help

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

27773

gmayor
01-21-2021, 03:05 AM
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.

Edgar5155
01-21-2021, 03:40 AM
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

27775


when i open it see that is name is changed

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

gmayor
01-21-2021, 04:43 AM
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 workbookand 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.

Edgar5155
01-21-2021, 05:14 AM
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

27777

sorry again for bothering you

Edgar5155
01-21-2021, 05:33 AM
Thanks a lot Graham for your generous cooperation and efforts. it is solved now