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