Outlook/Excel cvs email attachments for daily updated dashboard

This is my first time posting on a forum, so please excuse me if i fudge any rules inadvertently.

I am a novice when it comes to VBA in both excel and outlook. I'm hoping someone might be able to help me out as i haven't found any existing code suited quite for what i'm doing:

Every morning I receive 7 emails spaced 10 minutes apart with subjects that change per facility (eg. Facility A Dashboard; Facility B Dashboard; Facility C Dashboard, etc). Each email has a single .csv file attached to it that shares the subject name of the email. The data contained within is essentially customer satisfaction data where we are looking at the percent of customers that have rated us a 9 or 10. The row that contains the header for the columns in the data varies between rows 23 & 27 depending on the facility. The first 1 to 23 or 26 rows are filled with survey information that is not part of the data. The cell that has the daily updated year to date value is always in column F and is always the first row after the headers.

Needs:

• To have outlook recognize the emails upon receipt and process
• To extract the value in this cell either to either
  
  • network shared .xlsx file that consists of 3 columns in one worksheet The 3 columns would have the date, percent rated 9 or 10, and the facility name.
  • an Access Database consisting of the same
  
  
  
• 7 excel charts that demonstrate the monthly daily trend and monthly trend

I have no Access experience so if that is recommended, I will need someone to hold my hand through the process.

Thank you for your help in advance.

The immediate problem I can see is how to identify to the macro where the data you want to extract begins and ends when it apparently varies. At the very least you would have to post a sample CSV file so that we can get a feel for what you are trying to do. Identifying the messages and grabbing the attachments is relatively straightforward. Reading the attachments when the data you want to access is not always in the same place is more of an issue. Once you have that data it doesn't matter whether you write to an Access table or an Excel one, but I would have thought that as you want to chart the information, the use of Excel is indicated?

Gmayor,
Thank you for your response. I will be able to upload an example this evening. To clarify one thing about my previous post, while the cell that contains the required data changes between facilities, it is always the same for that facility. Meaning that facility A will always be in cell F24 and facility B will always be in cell F26. Not sure if that makes a difference without seeing the csv, but I will post an example tonight. If excel would be the best place to store the information that will be perfectly fine for me.
Thank you,
xraytech81

Having the same values for each facility should work, but it would be helpful to see a sample of the csv so I can see exactly what it is that you are trying to extract from it - ideally by reading directly from the CSV file, without opening it in Excel first.

On reflection the following should be close. Run from a rule that identifies the incoming messages, the main macro will extract the data from the numbered line (j) in the csv attachment to the named workbook/sheet. Note that you will have to set additional case statements to reflect all the subjects with the value of j changed as appropriate to reflect the line numbers from the CSV files.

The macro also only extracts the first three fields on the line:
strValues = vData(0) & "', '" & vData(1) & "', '" & vData(2)
You will need to change the values if you want different fields (which is another reason why I wanted to see the csv file).

The workbook must exist and the worksheet must have only three columns with a header row at row 1.

The macro only extracts one line from the CSV, it will need modification to work with more than one line.

I have included a test macro to test with existing messages. I'll leave the chart part to someone with a greater depth of Excel programming knowledge.

Code:

---

Option Explicit
Private Const strWorkBook As String = "C:\Path\Data.xlsx"
Private Const strSheet As String = "Sheet1"

Sub Test()
Dim olMsg As MailItem
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    ExtractCSV olMsg
lbl_Exit:
    Exit Sub
End Sub

Sub ExtractCSV(olItem As MailItem)
'An Outlook macro by Graham Mayor (www.gmayor.com)
Dim olAttach As Attachment
Dim strFname As String
Dim strExt As String
Dim i As Long, j As Long
Dim strSaveFldr As String
Dim vData As Variant
Dim strValues As String

    strSaveFldr = Environ("Temp") & Chr(92)
    On Error GoTo CleanUp
    If olItem.Attachments.Count > 0 Then
        For j = olItem.Attachments.Count To 1 Step -1
            Set olAttach = olItem.Attachments(j)
            If olAttach.FileName Like "*.csv" Then
                strFname = olAttach.FileName
                olAttach.SaveAsFile strSaveFldr & strFname
                Select Case olItem.Subject
                    Case "Facility A Dashboard"
                        j = 24
                    Case "Facility B Dashboard"
                        j = 26
                    Case "Facility C Dashboard"
                        j = 24
                    Case "Facility D Dashboard"
                        j = 26
                    Case Else: GoTo CleanUp
                End Select
                vData = Split(DataToExcel(strSaveFldr & strFname, j), Chr(44))
                strValues = vData(0) & "', '" & vData(1) & "', '" & vData(2)
                WriteToWorksheet strWorkBook, strSheet, strValues
                Kill strSaveFldr & strFname
                Exit For
            End If
        Next j
    End If
CleanUp:
    Set olAttach = Nothing
    Set olItem = Nothing
lbl_Exit:
    Exit Sub
End Sub

Private Function DataToExcel(strFname As String, lngRow As Long)
'An Outlook macro by Graham Mayor (www.gmayor.com)
Dim i As Long
Dim strData As String
Dim FileNum As Integer

    FileNum = FreeFile()
    i = 0
    Open strFname For Input As #FileNum
    Do Until EOF(1)
        i = i + 1
        Line Input #1, strData
        If i = lngRow Then
            strData = Replace(strData, Chr(34), "")
            strData = Replace(strData, Chr(44) & Chr(44), "")
            DataToExcel = strData
            Exit Do
        End If
    Loop
    Close #FileNum
lbl_Exit:
    Exit Function
End Function

Private Function WriteToWorksheet(strWorkBook As String, _
                                strRange As String, _
                                strValues As String)
'An Office macro by Graham Mayor (www.gmayor.com)
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

---

Attachment 15413Sorry for the delay in posting the csv. I am going to give you code a try here, but here is a sample of the csv in the meantime.
Thanks again for all of your help.
xraytech81

The csv is meaningless without an explanation of what exactly you want extracting from it. The macro extracts only the first three columns in the numbered row.

gmayor,
I have been able to manipulate your code slightly to get the desired data into my spreadsheet.

vdata = Split(DataToExcel(strSaveFldr & strFname, j), Chr(44))
strValues = Format(Now - 1, "mm-dd-yyyy") & "', '" & olItem.Subject & "', '" & vdata(5)
WriteToWorksheet strWorkBook, strSheet, strValues
Kill strSaveFldr & strFname


The only remaining problem that I have is that both the date and vdata(5) are being imported as text. Is there a way to have them inserted as a date and a number, respectively?

Thanks again for your help.

If you want to post the entire code so I don't have to guess how you modified Graham's, I will take a look at it.

In the short snippet above, according to the "str" prefix and the concatenation, srtValues is a single String. That String can only be entered into one Cell on the Worksheet. That Cell will contain a String that will look like: 02/15/2016', 'Facility A Dashboard', ' 82.6

The entire code may tell a different story.

Off the top of my head:

Code:

---

ResponseLine = Filter(Split(CSVfile, CHR(44)), "% ")
Vdata = ResponseLine(Ubound(ResponseLine))

Select Case Mid(olItem.Subject, 9, 1)
Case "A": Rng = "F24"
Case "B": Rng = "F26"
'Etc
End Select

With Workbooks(strWorkBook)
With .Sheets(strSheet)
.Range(Rng) = Format(Vdata, "%##.#")
End With
End With

---

Thanks for your interest and help. Below is the code with my changes. In regards to the code you provided, I am unsure where I would place that.

Code:

---

Option Explicit
Private Const strWorkBook As String = "C:\Path\Data.xlsx"
Private Const strSheet As String = "Sheet1"
 
Sub Test()
    Dim olMsg As MailItem
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    ExtractCSV olMsg
lbl_Exit:
    Exit Sub
End Sub
 
Sub ExtractCSV(olItem As MailItem)
    'An Outlook macro by Graham Mayor
    Dim olAttach As Attachment
    Dim strFname As String
    Dim strExt As String
    Dim i As Long, j As Long
    Dim strSaveFldr As String
    Dim vData As Variant
    Dim strValues As String
   
    strSaveFldr = Environ("Temp") & Chr(92)
    On Error GoTo CleanUp
    If olItem.Attachments.Count > 0 Then
        For j = olItem.Attachments.Count To 1 Step -1
            Set olAttach = olItem.Attachments(j)
            If olAttach.FileName Like "*.csv" Then
                strFname = olAttach.FileName
                olAttach.SaveAsFile strSaveFldr & strFname
                Select Case olItem.Subject
                Case "Facility A Dashboard"
                    j = 24
                Case "Facility B Dashboard"
                    j = 26
                Case "Facility C Dashboard"
                    j = 24
                Case "Facility D Dashboard"
                    j = 26
                Case Else: GoTo CleanUp
                End Select
                vData = Split(DataToExcel(strSaveFldr & strFname, j), Chr(44))
                strValues = Format(Now - 1, "mm-dd-yyyy" & "', '" olItem.Subject & "', '" & vData(5)
                WriteToWorksheet strWorkBook, strSheet, strValues
                Kill strSaveFldr & strFname
                Exit For
            End If
        Next j
    End If
CleanUp:
    Set olAttach = Nothing
    Set olItem = Nothing
lbl_Exit:
    Exit Sub
End Sub
 
Private Function DataToExcel(strFname As String, lngRow As Long)
    'An Outlook macro by Graham Mayor
    Dim i As Long
    Dim strData As String
    Dim FileNum As Integer
   
    FileNum = FreeFile()
    i = 0
    Open strFname For Input As #FileNum
    Do Until EOF(1)
        i = i + 1
        Line Input #1, strData
        If i = lngRow Then
            strData = Replace(strData, Chr(34), "")
            strData = Replace(strData, Chr(44) & Chr(44), "")
            DataToExcel = strData
            Exit Do
        End If
    Loop
    Close #FileNum
lbl_Exit:
    Exit Function
End Function
 
Private Function WriteToWorksheet(strWorkBook As String, _
    strRange As String, _
    strValues As String)
    'An Office macro by Graham Mayor
    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

---

Quote:

---

In regards to the code you provided, I am unsure where I would place that.

---

Don't "put" it anywhere. I could not design it to fit in your code. It was just illustrative of one method of many.

In post #3 you said

Quote:

---

Meaning that facility A will always be in cell F24 and facility B will always be in cell F26.

---

Were you talking about the cells on some worksheet, or something in the CSV file?

I assumed you meant a Worksheet, But I think Graham assumed something in the CSV File :dunno

I was referring to the csv.

Just future use, that would be fields and lines, ie the sixth field of line# 24. "Cells" is Excel Worksheet nomenclature.

So... Back to your problem

Quote:

---

The only remaining problem that I have is that both the date and vdata(5) are being imported as text.

---

As I said

Quote:

---

In the short snippet above, according to the "str" prefix and the concatenation, strValues is a single String.

---

And I am not familiar with all the code Graham wrote. Trying to figure it out right now would just waste those two tall Mudslides I just drank. :whistle:

I am afraid you will have to wait for him.

Code:

---

vdata = Split(DataToExcel(strSaveFldr & strFname, j), Chr(44))
strValues = Format(Now - 1, "mm-dd-yyyy") & "', '" & olItem.Subject & "', '" & vdata(5)
WriteToWorksheet strWorkBook, strSheet, strValues
Kill strSaveFldr & strFname

---

strValues is an SQL string used to supply three text strings to three cells via the WriteToWorksheet function. You can't include formatting with the data beyond what is in the text string.

This process is used for speed when processing the messages as they arrive, avoiding the need to open the workbook in order to process it. You could however manipulate the worksheet independently of the macro with code in the Excel sheet, to set the formats of the columns that you are inserting text into.

As the macro does not create the workbook, if it is not present, I would suggest that you preformat the columns to the required formats using the format painter and the incoming values should adopt those formats. This is in fact a method I use to extract the daily exchange rates between GB Pounds, Euro and US Dollar from the daily update from XE.COM.

Thank you gmayor for all of your help in supplying this code last year. The code has functioned perfectly for the last year, however, within the last two weeks, something has gone awry. The code appears to be following each step and I am receiving no error messages but the data is no longer populating in the destination spreadsheet. I'm curious if it would be possible that the last step where it is opening the connection could be having a glitch. Like I need to reset the connection or something? Any thoughts or ideas are appreciated.
Thanks.

Does it work if you start a new worksheet? If you have edited the worksheet it may no longer be in a format that the code can work with.