我从这个网站上的另一个问题中获取了这段代码,并对其进行了修改(不多)以满足我自己的需要,并且它运行良好。感谢 siddharth-rout。它所做的是从目录树中的已关闭文件中提取信息,并将该信息列出到自己的行中。
我真正想做但想不通的一件事是获取文件路径并将其放到相关行上,例如:
Sheets("Sheet1").Cells(r, 7).Value = gValue 'ie the file name
gValue 是文件路径和名称。
我知道 GetInfoFromClosedFile 具有我想要的 wbFile 值,但我不知道如何将其传递给 gValue。我的编程技能非常平庸,所以请善待。我知道这不是说那么简单:
Sheets("Sheet1").Cells(r, 7).Value = wbFile
但这就是我想要的。如果有人能指出我正确的方向,那就太好了。
我提前谢谢你。
我在下面借来的代码:
Option Explicit
Dim wbList() 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
Dim i As Long, r As Long
FolderName = ThisWorkbook.Path & "\Receiving Temp"
ProcessFiles FolderName, "*.xls"
If wbCount = 0 Then Exit Sub
r = 1
For i = 1 To UBound(wbList)
'~~> wbList(i) will give you something like
' C:\Receiving Temp\aaa.xls
' C:\Receiving Temp\FOLDER1\aaa.xls
Debug.Print wbList(i)
r = r + 1
cValue = GetInfoFromClosedFile(wbList(i), "Quality Rep.", "c9")
bValue = GetInfoFromClosedFile(wbList(i), "Quality Rep.", "o61")
aValue = GetInfoFromClosedFile(wbList(i), "Quality Rep.", "ae11")
dValue = GetInfoFromClosedFile(wbList(i), "Quality Rep.", "v9")
eValue = GetInfoFromClosedFile(wbList(i), "Quality Rep.", "af3")
fValue = GetInfoFromClosedFile(wbList(i), "Non Compliance", "a1")
Sheets("Sheet1").Cells(r, 1).Value = cValue
Sheets("Sheet1").Cells(r, 2).Value = bValue
Sheets("Sheet1").Cells(r, 3).Value = aValue
Sheets("Sheet1").Cells(r, 4).Value = dValue
Sheets("Sheet1").Cells(r, 6).Value = eValue
Sheets("Sheet1").Cells(r, 5).Value = fValue
Next i
End Sub
'~~> This function was taken from
'~~> http://www.vbaexpress.com/kb/getarticle.php?kb_id=245
Sub ProcessFiles(strFolder As String, strFilePattern As String)
Dim strFileName As String, strFolders() As String
Dim i As Long, iFolderCount As Long
'~~> Collect child folders
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
'~~> process files in current folder
strFileName = Dir$(strFolder & "\" & strFilePattern)
Do Until strFileName = ""
wbCount = wbCount + 1
ReDim Preserve wbList(1 To wbCount)
wbList(wbCount) = strFolder & "\" & strFileName
strFileName = Dir$()
Loop
'~~> Look through child folders
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 to get file name from the full path
'~~> Taken from http://www.ozgrid.com/VBA/GetExcelFileNameFromPath.htm
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