Get data from excel files in folder based on the name of the sheet

[storm525]

0 down vote favorite

I am a newbie here, but found superb solutions from the members of this forum. What I´m looking for is to get data from excel files in specific directory. What I found here was awesome, and helped me to partially solve my problem, but not the whole thing. I need to get data from various excel files in specific directory. Here I found vba script that is making almost the thing I need, except 2 thing: 1. It gets data from every excel file found in directory, I only need data from files containing specific sheets. The files are detailed information about projects, information are updated weekly, so every sheet in the file is named by the abbreviation CW (means calendar week), space and number of the week. Different projects run different weeks. The folder is basically month summary. So the project one keeps running from week 2 up until week 8, another one from week 1 til week 5 and so on. From this you can see, that when I have, for instance 8 files in the folder, relevant information and the given week containing for example 5 files. The script doesn't recognize it and it gives something like !N/A result for the weeks, that are not in given files. Is it possible to adjust it, that only flies with those specific sheets would be processed? 2. I need to format the values, from one of them i need left 2 characters, from another one 4 right characters, another 3 i need get divided by 1000. If I put these conditions into the script, I think, that because of the #Ref!results, it stops working... Does anybody have solution for that? Thanx in advance. Option Explicit Dim wbList() As String, wsList() As String Dim wbCount As Long Sub ReadDataFromAllWorkbooksInFolder() Dim FolderName As String Dim cValue As Variant, bValue As Variant, aValue As Variant Dim dValue As Variant, eValue As Variant, fValue As Variant, gValue As Variant Dim i As Long, r As Long, j As Long Dim MyPath As Variant If ActiveSheet.Range("K6") < 10 Then MyPath = ActiveSheet.Range("J2") & Chr(45) & Chr(48) & ActiveSheet.Range("K6") Else: MyPath = ActiveSheet.Range("J2") & Chr(45) & ActiveSheet.Range("K6") End If FolderName = ActiveWorkbook.Path & "\WER - laufend\" & MyPath ProcessFiles FolderName, "*.xl*" If wbCount = 0 Then Exit Sub r = 9 For i = 1 To UBound(wbList) Debug.Print wbList(i) r = r + 1 aValue = GetInfoFromClosedFile(wbList(i), "KW" & Chr(32) & ActiveSheet.Range("H4"), "n1") bValue = GetInfoFromClosedFile(wbList(i), "KW" & Chr(32) & ActiveSheet.Range("H4"), "c2") cValue = GetInfoFromClosedFile(wbList(i), "KW" & Chr(32) & ActiveSheet.Range("H4"), "c3") dValue = GetInfoFromClosedFile(wbList(i), "KW" & Chr(32) & ActiveSheet.Range("H4"), "n7") eValue = GetInfoFromClosedFile(wbList(i), "KW" & Chr(32) & ActiveSheet.Range("H4"), "n78") fValue = GetInfoFromClosedFile(wbList(i), "KW" & Chr(32) & ActiveSheet.Range("H4"), "n11") gValue = GetInfoFromClosedFile(wbList(i), "KW" & Chr(32) & ActiveSheet.Range("H4"), "l25") ActiveSheet.Cells(r, 1).Value = aValue ActiveSheet.Cells(r, 2).Value = bValue ActiveSheet.Cells(r, 3).Value = cValue ActiveSheet.Cells(r, 4).Value = dValue ActiveSheet.Cells(r, 5).Value = eValue ActiveSheet.Cells(r, 7).Value = fValue ActiveSheet.Cells(r, 9).Value = gValue Next i End Sub Sub ProcessFiles(strFolder As String, strFilePattern As String) Dim strFileName As String, strFolders() As String Dim i As Long, iFolderCount As Long strFileName = Dir$(strFolder & "\", vbDirectory) Do Until strFileName = "" If (GetAttr(strFolder & "\" & strFileName) And vbDirectory) = vbDirectory Then If Left$(strFileName, 1) <> "." Then ReDim Preserve strFolders(iFolderCount) strFolders(iFolderCount) = strFolder & "\" & strFileName iFolderCount = iFolderCount + 1 End If End If strFileName = Dir$() Loop strFileName = Dir$(strFolder & "\" & strFilePattern) Do Until strFileName = "" wbCount = wbCount + 1 ReDim Preserve wbList(1 To wbCount) wbList(wbCount) = strFolder & "\" & strFileName strFileName = Dir$() Loop For i = 0 To iFolderCount - 1 ProcessFiles strFolders(i), strFilePattern Next i End Sub Private Function GetInfoFromClosedFile(ByVal wbFile As String, _ wsName As String, cellRef As String) As Variant Dim arg As String, wbPath As String, wbName As String GetInfoFromClosedFile = "" wbName = FunctionGetFileName(wbFile) wbPath = Replace(wbFile, "\" & wbName, "") arg = "'" & wbPath & "\[" & wbName & "]" & _ wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1) On Error Resume Next GetInfoFromClosedFile = ExecuteExcel4Macro(arg) End Function Function FunctionGetFileName(FullPath As String) Dim StrFind As String Dim i As Long Do Until Left(StrFind, 1) = "\" i = i + 1 StrFind = Right(FullPath, i) If i = Len(FullPath) Then Exit Do Loop FunctionGetFileName = Right(StrFind, Len(StrFind) - 1) End Function

<tbody>
</tbody>