Question

我在本网站上从another question获取了此代码并对其进行了修改（不是太多）以满足我自己的需求并且它的工作非常出色。感谢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

Answer 1

你最需要做的就是添加这一行：

    Sheets("Sheet1").Cells(r, 7).Value = wbList(i)

紧接着这些界限：

    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

从子目录中的excel文件中获取数据和文件名

1 个答案: