1

我从这个网站上的另一个问题中获取了这段代码，并对其进行了修改（不多）以满足我自己的需要，并且它运行良好。感谢 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
4

1 回答 1

0

很可能您需要做的是添加这一行：

    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
于 2013-07-05T09:21:14.730 回答