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

storm525

New Member
Joined
Apr 23, 2015
Messages
14

<tbody>
[TD="class: votecell"] 0 down vote favorite [/TD]
[TD="class: postcell"] 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.

Code:
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

[/TD]

[TD="class: votecell"][/TD]
[TD="class: postcell"][/TD]

</tbody>
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

Forum statistics

Threads
1,223,713
Messages
6,174,043
Members
452,542
Latest member
Bricklin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top