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
Bookmarks