Open attached CSV, copy newdata and paste it to database CSV

[Deniz]

Hi,

I am receiving some scheduled emails with attached csv files. Currently I have a macro that saves the attached files to a specific folder, and then I manually open each csv, copy the new data and append it to the end of my database.csv file.

Is it possible to have an outlook macor that:
1- Save the attached imcoming.csv file.*
2- Open the incoming.csv
3- Copy the data from incoming.csv**
4- Open the database.csv
5- Append*** the copied range from incoming.csv to the end of database.csv
6- save files
6- Close csv files.

*I already have a code to download and save the attached part. The rest of the code is what I am missing.
**The incomin.csv file has headers and data row number is dynamic. I do not know how many row it has when arrived.
***the new data should be added to the end of my database.csv file. The database.csv keeps groving.

I would appreciate any help to achive this.
Thank you.

/deniz

 

[Diane Poremsky]

it's possible but I'm not sure if its better to do it all in outlook or have outlook open the csv file in Excel and let excel do the work.

I don't have any code samples that do this but these two show how to do some of the things you need:
Save and open attachment sample: http://www.slipstick.com/outlook/email/save-open-attachment/
write data to excel to next available row: http://www.slipstick.com/developer/vba-copy-outlook-email-excel-workbook/

 

[Deniz]

Thank you for the hint Diane. I checked different samples and managed to put together an outlook code that does what I wanted.

It does all that I listed in my first mail. Outlook processes the attached file and then deletes the incoming mail as well.

I trigger this macro with outlook rules when a mail arrives with the subject I defined in the rule.

Public Sub AddtoDatabase2() 
    Dim objOL As Outlook.Application 
    Dim pobjMsg As Outlook.MailItem 'Object 
    Dim objSelection As Outlook.Selection 
    ' Get the path to your My Documents folder 
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16) 
    On Error Resume Next 
    ' Instantiate an Outlook Application object. 
    Set objOL = CreateObject("Outlook.Application") 
    ' Get the collection of selected objects. 
    Set objSelection = objOL.ActiveExplorer.Selection 
    For Each pobjMsg In objSelection 
            AddtoDatabase2_Parameter pobjMsg 
    Next 
ExitSub: 
    Set pobjMsg = Nothing 
    Set objSelection = Nothing 
    Set objOL = Nothing 
 
End Sub 
Public Sub AddtoDatabase2_Parameter(objMsg As MailItem) 
    Dim objAttachments As Outlook.Attachments 
    Dim i As Long 
    Dim lngCount As Long 
    Dim strFile As String 
    Dim strFolderpath As String 
    Dim strDeletedFiles As String    
   ' Get the path to your My Documents folder 
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16) 
    ' On Error Resume Next 
    ' Set the Attachment folder. 
    strFolderpath = "C:\test\" 
        ' Get the Attachments collection of the item. 
        Set objAttachments = objMsg.Attachments 
        lngCount = objAttachments.Count 
        If lngCount > 0 Then 
            ' We need to use a count down loop for removing items 
            ' from a collection. Otherwise, the loop counter gets 
            ' confused and only every other item is removed. 
            For i = lngCount To 1 Step -1 
                ' Save attachment before deleting from item. 
                ' Get the file name. 
                strFile = "Source.csv" 
                ' Combine with the path to the Temp folder. 
                strFile = strFolderpath & strFile 
                ' Save the attachment as a file. 
                objAttachments.Item(i).SaveAsFile strFile 
                ' Delete the attachment. 
                objAttachments.Item(i).Delete 
                'write the save as path to a string to add to the message 
                'check for html and use html tags in link 
                If objMsg.BodyFormat <> olFormatHTML Then 
                    strDeletedFiles = strDeletedFiles & vbCrLf & "" 
                    Else 
                    strDeletedFiles = strDeletedFiles & "" & "<a href='//" & _ 
                    strFile & "'>" & strFile & "</a>" 
                End If 
            Next i 
        End If 
      
       objMsg.Save 
        objMsg.Delete 
   
 
ExitSub: 
    Set objAttachments = Nothing 
    Set objMsg = Nothing 
    Set objOL = Nothing 
 

   Dim oXLAppSource As Excel.Application ' 
    Dim oXLBookSource As Excel.Workbook 
    Dim oXLSheetSource As Excel.Worksheet 
    Dim rCountSource As Long 
    Dim rangeSource As Range 
    Dim tmpCSV As String 'string to hold the CSV info 
    Dim f As Integer 
 
' Open Source Workbook and copy the new data 
    Set oXLAppSource = New Excel.Application  'Create a new instance of Excel 
    Set oXLBookSource = oXLAppSource.Workbooks.Open("C:\test\source.csv") 
    Set oXLSheetSource = oXLBookSource.Worksheets(1)  'Work with the first worksheet 
    oXLAppSource.Visible = False               'Show it to the user 
    rCountSource = oXLSheetSource.Range("A" & oXLSheetSource.Rows.Count).End(-4162).Row 
 
If rCountSource > 1 Then 
    Const CSVFile As String = "C:\test\database.csv" 'replace with your filename
   f = FreeFile
   Open CSVFile For Append As #f 
    tmpCSV = Range2CSV(oXLSheetSource.Range("A2:L" & rCountSource)) 
    Print #f, tmpCSV 
    Close #f 
End If 
  oXLBookSource.Close 1 
  oXLAppSource.Quit 
 
End Sub 
 
Function Range2CSV(list) As String 
Dim tmp As String 
Dim cr As Long 
Dim r As Range 
 
If TypeName(list) = "Range" Then 
cr = 1 
 
For Each r In list.Cells 
If r.Row = cr Then 
If tmp = vbNullString Then 
tmp = r.Value 
Else 
tmp = tmp & "," & r.Value 
End If 
Else 
cr = cr + 1 
If tmp = vbNullString Then 
tmp = r.Value 
Else 
tmp = tmp & Chr(10) & r.Value 
End If 
End If 
Next 
End If 
 
Range2CSV = tmp 
End Function