1

このサイトの別の質問からこのコードを取得し、自分のニーズに合わせて (それほどではありませんが) 変更しましたが、見事に機能しています。siddharth-rout に感謝します。それが行うことは、ディレクトリ ツリー内の閉じられたファイルから情報を取得し、その情報を独自の行に一覧表示することです。

私が本当にやりたいのに理解できないことの1つは、ファイルパスを取得して、それを関連する行に配置することです。たとえば、次のようになります。

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