Help with VBA that pulls data from another workbooks

**lathog** · 09-19-2011, 04:23 PM

I am new to the forum, but would like to express appreciation for any help in advance. I came across the following post as I tried identifying a solution to my problem:

http://www.excelforum.com/excel-prog...ther-file.html

I have sheets that are being created daily as well, and I want to copy the data over to a master sheet to keep a daily record of the totals generated from the query that is generating the daily Excel files.

I copied the code from the above mentioned post and tried modifying it for my specific use. The macro runs, but returns an error saying that the file was not processed. I am pretty novice with VBA and am trying to troubleshoot the code to see what additional changes I would need to make for it to function properly. I am not sure, but I think it may be something involved with either the date format or the name of the file being processed. Nonetheless, I 'd rather ask for help than scratch my head forever.

I have attached two files to help show what is taking place.

Also, here is a copy of the code with the changes that I made:

Sub CollectData()
'Author:    Jerry Beaucaire, ExcelForum.com
'Date:      11/23/2010
'Summary:   Open all the files in a specific folder and add key data to database
'           moves imported files to "imported" folder to preclude repeats

Dim fPath As String, fDone As String
Dim fName As String, fDate As String
Dim wsData As Worksheet, wbImp As Workbook
Dim dRow As Long, ErrMsg As String

'Setup
    Application.ScreenUpdating = False
    Set wsData = ThisWorkbook.Sheets("Data")
    fPath = "S:\Customer Relations-DNR\Process Improvement\QGC Customer Service Dept. Projects\Misc. Projects\e-Bill Project\Queries\Grog\New Data\"
    fDone = "S:\Customer Relations-DNR\Process Improvement\QGC Customer Service Dept. Projects\Misc. Projects\e-Bill Project\Queries\Grog\Processed/"
    
    fName = Dir(fPath & "*.xlsx")
    On Error Resume Next

'Collect data
    Do While Len(fName) <> 0
        fDate = Format(Left(fName, InStrRev(fName, ".") - 1), "DD-MM-YY")
        If IsDate(fDate) Then
            dRow = wsData.Range("A:A").Find(fDate, LookIn:=xlValues, LookAt:=xlWhole).Row
            If dRow <> 0 Then
                Set wbImp = Workbooks.Open(fPath & fName)
                With Sheets("Sheet1")
                    .Range("C2").Copy wsData.Range("B" & dRow)
                    .Range("C3").Copy wsData.Range("C" & dRow)
                    .Range("C4").Copy wsData.Range("D" & dRow)
                    .Range("C5").Copy wsData.Range("E" & dRow)
                    .Range("C6").Copy wsData.Range("F" & dRow)
                    .Range("C7").Copy wsData.Range("G" & dRow)
                    .Range("C8").Copy wsData.Range("H" & dRow)
                    .Range("C9").Copy wsData.Range("I" & dRow)
                End With
                wbImp.Close False
                Name (fPath & fName) As (fDone & fName)
            Else
                ErrMsg = ErrMsg & vbLf & "    " & fName
            End If
        Else
            ErrMsg = ErrMsg & vbLf & "    " & fName
        End If
        
        fName = Dir
        dRow = 0
    Loop
                    
If ErrMsg <> "" Then MsgBox "The following files were not processed:" & vbLf & ErrMsg
Application.ScreenUpdating = True
End Sub

'Note the fPath and the fDone strings...

    'fPath is the directory where the files are found, remember the final \ in that string

    'fDone is where the files are moved to after they are imported so you know they are done. Create that directory if needed.

    'Errors are buffered and presented as a list of files that were not processed at the end. Try putting a garbage file in that directory that isn't named for a date and you'll see.

Thanks again in advance

**JBeaucaire** · 09-19-2011, 09:26 PM

First off correct your fDone string, notice the / at the end is going the wrong way...:

.....\Processed/"

Next, the macro is looking to test the fName to see if it's a date, proceed if it is. Your filename HAVE a date in them, but they aren't a date. So you'll need to remove that part, or change the test.

The only need for a test is if there are other files in that folder to ignore. If not, take that IF test out and just process those files found.

**lathog** · 09-20-2011, 09:51 AM

JBeaucaire,

Thanks for pointing out the error on the fDone string.

I updated the string and then renamed the files to be processed as dates, ie: 9-19-11, 9-20-11. I also I changed the date format in the destination sheet to DD-MMM-YY. The macro runs without errors and it moves the files into the "processed" folder; however, the data isn't pasting into the destination worksheet.

Just curious though, could I use the file create date rather than the file name to bring the data across in order from oldest to newest and have it look for the corresponding date in the destination sheet? I don't have as much control over the naming convention of the files that need to be processed.

Thanks for your help and patience.

**JBeaucaire** · 09-20-2011, 10:36 AM

I think you can leave the names of the files alone, if they always start with ToadExport that can be removed explicitly, or at least the date immediately after can be found easily.

1) Remove all code trom ThisWorkbook module. That module is for workbook level event code, not on-demand macros like this.

2) Add an empty standard code module (Insert > Module), then paste in this new version of the macro:

Option Explicit

Sub CollectData()
'Author:    Jerry Beaucaire, ExcelForum.com
'Date:      11/23/2010    (9/20/2011)
'Summary:   Open all the files in a specific folder and add key data to database
'           moves imported files to "imported" folder to preclude repeats

Dim fPath As String, fDone As String
Dim fName As String, fDate As String
Dim wsData As Worksheet, wbImp As Workbook
Dim dRow As Long, ErrMsg As String

'Setup
    Application.ScreenUpdating = False
    Set wsData = ThisWorkbook.Sheets("Data")
    fPath = "C:\2011\Test\"
    fDone = "C:\2011\Test\Imported\"
    
    fName = Dir(fPath & "*.xlsx")
    On Error Resume Next

'Collect data
    Do While Len(fName) <> 0
        fDate = Format(Left(Replace(fName, "ToadExport", ""), 10), "M/D/YYYY")
        If IsDate(fDate) Then
            dRow = wsData.Range("A:A").Find(fDate, LookIn:=xlValues, LookAt:=xlWhole).Row
            If dRow <> 0 Then
                Set wbImp = Workbooks.Open(fPath & fName)
                
                wsData.Range("B" & dRow).Resize(, 8).Value = _
                    WorksheetFunction.Transpose(wbImp.Sheets(1).Range("C2:C9").Value)
                
                wbImp.Close False
                Name (fPath & fName) As (fDone & fName)
            Else
                ErrMsg = ErrMsg & vbLf & "    " & fName
            End If
        Else
            ErrMsg = ErrMsg & vbLf & "    " & fName
        End If
        
        fName = Dir
        dRow = 0
    Loop
                    
If ErrMsg <> "" Then MsgBox "The following files were not processed:" & vbLf & ErrMsg
Application.ScreenUpdating = True
End Sub

'Note the fPath and the fDone strings...
'fPath is the directory where the files are found, remember the final \ in that string
'fDone is where the files are moved to after they are imported so you know they are done. Create that directory if needed.
'Errors are buffered and presented as a list of files that were not processed at the end. Try putting a garbage file in that directory that isn't named for a date and you'll see.

Notice my fPath and fDone strings end with a \ while the code I found in the wb you uploaded did not.