Macro to find latest csv file by date and copy to other workbook

[gobits]

Hi,

I have found some answers to somewhat similar questions but none that fits my need and unfortunately I am not experienced enough with VBA to piece together a functioning macro from what I've found searching online so far.

What I need to do is to create a macro that runs automatically once per day. I know how to use the Workbook.open function or a button but I'd rather have the macro run on a timer if possible. If that's not possible (which I'm thinking is probably the case), I'll run it when the workbook opens. Here's what I need the macro to do:

I need the macro in my workbook to go to a remote server directory, look for the latest file by the date in the name of the file (e.g. "MyDataFile_01-01-2014.csv"), there will be many files, same name but different dates in the directory. Once the file with the latest date is identified, I need to copy the data from "sheet 1", then look in my workbook for a worksheet named "MyDataFile"(without the date appended), find the last used row in the only table in this worksheet (lets say it's named "Table1"), whether this is row 2 (below the header) or row 2000, and append the copied data to this table.

Ideally, I'd like to have a message pop up if I have to run the macro on opening the workbook, stating that the latest data is being retrieved AND I would love it if the macro could "know" it the latest file has already been retrieved so I don't duplicate data - since I am appending the data to the bottom of a table - and if the latest available data is already in the workbook, a message stating this would be great as well. Generous commenting would also be appreciated since I am trying to learn how to do this myself.

This is a tall order (for me anyway) if anyone knows how to do this I would be elated because so far I am striking out on this one.

Thank you beforehand to anyone who can help me out.

G

 

[Rosen]

Here is some code that should do what your looking for.

Private Sub Workbook_Open()
    ' Variables
    Dim oMetadata As Worksheet
    Dim dtLatestDate As Date
    Dim dtCurrntDate As Date: dtCurrntDate = VBA.Now ' Note that I have declared and assigned a variable in one
                                                     ' line by using : to indicate that these are, for compiling
                                                     ' purpose, two seperate lines of code.
    Dim FilePath As String
    Dim File As Integer
    Dim oInput As Worksheet
    Dim lLine As Long, sLine As String, lColumn As Long, Pos As Long
    ' Change this to the remote directory you wish to pull the .csv file from.
    Const DIRECTORY As String = "\\networkservername\sharedfolder\subfolder\"
    ' Unique Sheet name for a sheet to store data about the updates
    Const METADATA As String = "METADATA_DATES"
    ' Cell reference in METADATA sheet to the Latest Date
    Const LATESTDATE As String = "A1"
    ' the Files date format, couldn't tell by your post if you use MM-DD-YYYY or DD-MM-YYYY, so I guessed.
    Const DATEFORMAT As String = "MM-DD-YYYY"
    Const SHEET As String = "MyDataSheet"
    ' We need to store and retrieve the last latest date uploaded to ensure we don't duplicate an upload
    ' for this purpose we will create and hide (as it is not needed for any user) a worksheet called
    ' METADATA_DATES
    ' To check to see if this sheet already exists we will need to call it, if it doesn't exist it will
    ' raise an error, as we are expecting this we can bypass the error message and handle it ourselves by
    ' using the Resmue Next, which will ignore the error.
    On Error Resume Next
    Set oMetadata = Sheets(METADATA)
    ' After Assigning Sheets(METADATA) If there is no sheet called METADATA (or the value it contains) will
    ' raise an error which will be ingored but will still store the error in the Err object.  The Err object's
    ' Number field will be set to an value other then 0 if this occures, so to test if we don't have a sheet
    ' called METADATA we simply check if the Err.Number is anything but 0
    If Not Err.Number = 0 Then
        ' So we don't have a METADATA sheet, we need to create one by adding a new sheet to the Sheets
        ' collection
        Set oMetadata = Sheets.Add
        ' Rename it to our METADATA name
        oMetadata.Name = METADATA
        ' Make it invisable to the user (this isn't necessarily required just something us paranoid programers
        ' do because we find users to be untrustworthy... they just want to ruin my program... they are out to
        ' get me... RUN!)
        oMetadata.Visible = xlSheetVeryHidden ' only accessable via code
        ' Now that we have a new sheet, it is assumed that we have been doing this already for some time and will
        ' have already uploaded (in some fastion) csv files to this spreadsheet, to ensure we don't upload one
        ' which is already uploaded, we can prompt the user to advise of the lastest uploaded date.
        dtLatestDate = CDate(InputBox(Prompt:="Please provided the date of the last csv file uplaoded", Title:="Latest Date"))
        ' This last line could have caused another error to occure if something other then a date is entered into
        ' the InputBox, but not to worry, we will simply treate this as a January 0, 1900 date (default), better
        ' cantrols can be used if necessary, but Im far too lazy for something more complicated :P
        oMetadata.Range(LATESTDATE).Value = dtLatestDate
        ' Since we have handled our error, we can clear the Err object
        Err.Clear
    End If
    ' We no longer need to bypass errors
    On Error GoTo 0
    ' Now that we have access to our METADATA sheet through oMetadata we can access our lastest date.
    dtLatestDate = oMetadata.Range(LATESTDATE).Value
    ' Now we will cycle back from the current date till the latest date looking for a valid file.
    Do While dtCurrntDate > dtLatestDate
        ' Now we check if this dtCurrntDate has an associated file by converting it into the file path name and
        ' checking if that file exists.
        FilePath = DIRECTORY & SHEET & "_" & Format(dtCurrntDate, "MM-DD-YYYY") & ".csv"
        ' The Dir function returns the pathname of the first file that matches the parameters provided, or a null string
        ' if the parameters are not matched.
        If Not VBA.Dir(FilePath) = vbNullString Then
            ' Now that we have found our file it is time to import it into our MyDataFile
            Set oInput = Sheets(SHEET)
            ' Find the first empty line (this assumes that there cannot be a blank space in column A)
            lLine = 2
            Do Until oInput.Range("A" & lLine).Value = vbNullString
                lLine = lLine + 1
            Loop
            ' We now have our blank line so we can start the inport, do do this we first open the file
            File = VBA.FreeFile
            Open FilePath For Input As File
            ' We will be reading each line of the file and inputting it into excel
            Do Until VBA.EOF(File)
                ' Retrieve one line (or row) from the file
                Line Input #File, sLine
                lColumn = 1
                Do Until sLine = vbNullString
                    ' Finding the first instance of "," in the line
                    Pos = VBA.Strings.InStr(1, sLine, ",")
                    If Not Pos = 0 Then
                        ' Assign only the value before the "," to our cell.
                        oInput.Cells(lLine, lColumn).Value = VBA.Strings.Left(sLine, Pos - 1)
                        ' Remove the first element in sLine from sLine.
                        sLine = VBA.Strings.Right(sLine, VBA.Strings.Len(sLine) - Pos)
                        lColumn = lColumn + 1
                    Else
                        oInput.Cells(lLine, lColumn).Value = sLine
                        sLine = vbNullString
                    End If
                Loop
                lLine = lLine + 1
            Loop
            Close File
            ' We have found and handled our .csv file, nothing left to do, so we exit the loop
            Exit Do
        End If
        '  Deincrement the date by one day and run through above code again.
        dtCurrntDate = dtCurrntDate - 1 ' Subtracting one from a date reduces the date by one whole day as the Date
                                        ' variable is stored in a double-precision floating-point value where the
                                        ' date is the number of days sinse January 0, 1900 and the time is derived
                                        ' from the value after the decimal
    Loop
End Sub

Just remember to always back up your work before running new code (the above code is NOT tested).

Hope this helps.

 

[gobits]

Wow, This looks great! Thank you for the very quick reply and what looks like an elegant and very well commented solution. I'll be studying and working on this today. I will let you know how this turns out for me.

Again, Thank you.

G

Here is some code that should do what your looking for.

Private Sub Workbook_Open()
    ' Variables
    Dim oMetadata As Worksheet
    Dim dtLatestDate As Date
    Dim dtCurrntDate As Date: dtCurrntDate = VBA.Now ' Note that I have declared and assigned a variable in one
                                                     ' line by using : to indicate that these are, for compiling
                                                     ' purpose, two seperate lines of code.
    Dim FilePath As String
    Dim File As Integer
    Dim oInput As Worksheet
    Dim lLine As Long, sLine As String, lColumn As Long, Pos As Long
    ' Change this to the remote directory you wish to pull the .csv file from.
    Const DIRECTORY As String = "\\networkservername\sharedfolder\subfolder\"
    ' Unique Sheet name for a sheet to store data about the updates
    Const METADATA As String = "METADATA_DATES"
    ' Cell reference in METADATA sheet to the Latest Date
    Const LATESTDATE As String = "A1"
    ' the Files date format, couldn't tell by your post if you use MM-DD-YYYY or DD-MM-YYYY, so I guessed.
    Const DATEFORMAT As String = "MM-DD-YYYY"
    Const SHEET As String = "MyDataSheet"
    ' We need to store and retrieve the last latest date uploaded to ensure we don't duplicate an upload
    ' for this purpose we will create and hide (as it is not needed for any user) a worksheet called
    ' METADATA_DATES
    ' To check to see if this sheet already exists we will need to call it, if it doesn't exist it will
    ' raise an error, as we are expecting this we can bypass the error message and handle it ourselves by
    ' using the Resmue Next, which will ignore the error.
    On Error Resume Next
    Set oMetadata = Sheets(METADATA)
    ' After Assigning Sheets(METADATA) If there is no sheet called METADATA (or the value it contains) will
    ' raise an error which will be ingored but will still store the error in the Err object.  The Err object's
    ' Number field will be set to an value other then 0 if this occures, so to test if we don't have a sheet
    ' called METADATA we simply check if the Err.Number is anything but 0
    If Not Err.Number = 0 Then
        ' So we don't have a METADATA sheet, we need to create one by adding a new sheet to the Sheets
        ' collection
        Set oMetadata = Sheets.Add
        ' Rename it to our METADATA name
        oMetadata.Name = METADATA
        ' Make it invisable to the user (this isn't necessarily required just something us paranoid programers
        ' do because we find users to be untrustworthy... they just want to ruin my program... they are out to
        ' get me... RUN!)
        oMetadata.Visible = xlSheetVeryHidden ' only accessable via code
        ' Now that we have a new sheet, it is assumed that we have been doing this already for some time and will
        ' have already uploaded (in some fastion) csv files to this spreadsheet, to ensure we don't upload one
        ' which is already uploaded, we can prompt the user to advise of the lastest uploaded date.
        dtLatestDate = CDate(InputBox(Prompt:="Please provided the date of the last csv file uplaoded", Title:="Latest Date"))
        ' This last line could have caused another error to occure if something other then a date is entered into
        ' the InputBox, but not to worry, we will simply treate this as a January 0, 1900 date (default), better
        ' cantrols can be used if necessary, but Im far too lazy for something more complicated :P
        oMetadata.Range(LATESTDATE).Value = dtLatestDate
        ' Since we have handled our error, we can clear the Err object
        Err.Clear
    End If
    ' We no longer need to bypass errors
    On Error GoTo 0
    ' Now that we have access to our METADATA sheet through oMetadata we can access our lastest date.
    dtLatestDate = oMetadata.Range(LATESTDATE).Value
    ' Now we will cycle back from the current date till the latest date looking for a valid file.
    Do While dtCurrntDate > dtLatestDate
        ' Now we check if this dtCurrntDate has an associated file by converting it into the file path name and
        ' checking if that file exists.
        FilePath = DIRECTORY & SHEET & "_" & Format(dtCurrntDate, "MM-DD-YYYY") & ".csv"
        ' The Dir function returns the pathname of the first file that matches the parameters provided, or a null string
        ' if the parameters are not matched.
        If Not VBA.Dir(FilePath) = vbNullString Then
            ' Now that we have found our file it is time to import it into our MyDataFile
            Set oInput = Sheets(SHEET)
            ' Find the first empty line (this assumes that there cannot be a blank space in column A)
            lLine = 2
            Do Until oInput.Range("A" & lLine).Value = vbNullString
                lLine = lLine + 1
            Loop
            ' We now have our blank line so we can start the inport, do do this we first open the file
            File = VBA.FreeFile
            Open FilePath For Input As File
            ' We will be reading each line of the file and inputting it into excel
            Do Until VBA.EOF(File)
                ' Retrieve one line (or row) from the file
                Line Input #File, sLine
                lColumn = 1
                Do Until sLine = vbNullString
                    ' Finding the first instance of "," in the line
                    Pos = VBA.Strings.InStr(1, sLine, ",")
                    If Not Pos = 0 Then
                        ' Assign only the value before the "," to our cell.
                        oInput.Cells(lLine, lColumn).Value = VBA.Strings.Left(sLine, Pos - 1)
                        ' Remove the first element in sLine from sLine.
                        sLine = VBA.Strings.Right(sLine, VBA.Strings.Len(sLine) - Pos)
                        lColumn = lColumn + 1
                    Else
                        oInput.Cells(lLine, lColumn).Value = sLine
                        sLine = vbNullString
                    End If
                Loop
                lLine = lLine + 1
            Loop
            Close File
            ' We have found and handled our .csv file, nothing left to do, so we exit the loop
            Exit Do
        End If
        '  Deincrement the date by one day and run through above code again.
        dtCurrntDate = dtCurrntDate - 1 ' Subtracting one from a date reduces the date by one whole day as the Date
                                        ' variable is stored in a double-precision floating-point value where the
                                        ' date is the number of days sinse January 0, 1900 and the time is derived
                                        ' from the value after the decimal
    Loop
End Sub

Just remember to always back up your work before running new code (the above code is NOT tested).

Hope this helps.

 

[Rosen]

To deal with your running it on a daily basis I would suggest using Window's schedule tasks to run a vbs script (just open text file and copy the following code into (amending the file location string)):

Dim objShell
Set objShell = WScript.CreateObject( "WScript.Shell" )
Dim FileToRun
FileToRun = "excel.exe "
FileToRun = FileToRun & """C:\Folder Name\Sub Folders\File Name.xlsm"""
objShell.Run(FileToRun)
Set objShell = Nothing

Now save as, change file type to All Files and call it whatever you would like, but end it in .vbs

Now setup a scheduled task to run the vbs file, if you need help with that let me know.

 

[gobits]

To deal with your running it on a daily basis I would suggest using Window's schedule tasks to run a vbs script (just open text file and copy the following code into (amending the file location string)):

Dim objShell
Set objShell = WScript.CreateObject( "WScript.Shell" )
Dim FileToRun
FileToRun = "excel.exe "
FileToRun = FileToRun & """C:\Folder Name\Sub Folders\File Name.xlsm"""
objShell.Run(FileToRun)
Set objShell = Nothing

Now save as, change file type to All Files and call it whatever you would like, but end it in .vbs

Now setup a scheduled task to run the vbs file, if you need help with that let me know.

Hi Rosen,

I'll give that a try, thank you. This file will be stored on Sharepoint. I'll talk to the admin and see if he can set up a schedule task on that server once I have finished with this macro. I have read through all the very clear commentary (thank you) and modified the variables to match my actual paths and worksheet names - the date format is actually YYYMMDD - currently running the macro and it seems to be working, at least with the initial file import. Once I have finished the first file, I'll add more files and test the data append functionality.

One thing that is happening is that the macro is taking a very long time to copy the data. The reason is that the .csv file has thousands of rows and my spreadsheet has a lot of formulas. I have done what I can (previous to this attempt at automating the data import) to minimize my formulas and make the file leaner but it is still not the fastest excel workbook in the world, far from it. So, going one row at a time is taking quite a while.

So, I'm wondering, instead of the one line copy loop:

Loop ' We now have our blank line so we can start the inport, do do this we first open the file File = VBA.FreeFile Open FilePath For Input As File ' We will be reading each line of the file and inputting it into excel     Do Until VBA.EOF(File)      ' Retrieve one line (or row) from the file      Line Input #File, sLine      lColumn = 1      Do Until sLine = vbNullString         ' Finding the first instance of "," in the line         Pos = VBA.Strings.InStr(1, sLine, ",")         If Not Pos = 0 Then             ' Assign only the value before the "," to our cell.             oInput.Cells(lLine, lColumn).Value = VBA.Strings.Left(sLine, Pos - 1)             ' Remove the first element in sLine from sLine.             sLine = VBA.Strings.Right(sLine, VBA.Strings.Len(sLine) - Pos)             lColumn = lColumn + 1         Else             oInput.Cells(lLine, lColumn).Value = sLine             sLine = vbNullString         End If      Loop      lLine = lLine + 1 Loop

</pre>
Would it be possible to have the code find the entire block of data (the csv files have no headers) and copy/paste the entire block at once rather than one line at a time. When I do this manually it doesn't take too much time (seconds). Again, I searched for some code solutions but I couldn't make sense of them enough to figure out how to correctly replace the one line at a time loop and it seems there was some arguing over what functions should be used in other forums. I am beginning to understand how your code works but there are still pieces that are unclear to me. I am definitely going to have to take a course or two before I can write code this complicated .

 

[gobits]

crap! seems I can't even copy a code segment properly for this forum...

 

[Rosen]

Try turning off automatic calculations

Application.Calculation = xlCalculationManual

at the beginning of the code and turning it back on

Application.Calculation = xlCalculationAutomatic

at the end.

Let me know if that helps or not.

 

[gobits]

Try turning off automatic calculations

Application.Calculation = xlCalculationManual

at the beginning of the code and turning it back on

Application.Calculation = xlCalculationAutomatic

at the end.

Let me know if that helps or not.

I turned off automatic calculation and screen updating, still, the macro ran for over an hour and only copied just over 1100 rows.

I'm still thinking that it will go faster if I can figure out how to ensure there is a blank line at the bottom of the table I'm importing to and then copy / paste the entire block of data at once rather than line by line.

Thank you for your help so far though.

 

[Rosen]

I can adjust the code to copy and paste, but I need to know if (a) are the number of columns static (if static how many columns) or dynamic (b) if dynamic are they all equal per file or variable per line (c) if variable per line is there a maximum number of columns?

 

[gobits]

I can adjust the code to copy and paste, but I need to know if (a) are the number of columns static (if static how many columns) or dynamic (b) if dynamic are they all equal per file or variable per line (c) if variable per line is there a maximum number of columns?

Hi Rosen, The columns are A:BA (53 columns), the number of rows will vary though. I have been trying to change the code but I keep breaking it.