2013-07-05 106 views
1

我已經在這個網站採取了這種代碼another question和修改了它(不是很多),以適應自己的需要和它一直工作出色,從Excel文件數據和文件名。感謝siddharth爲此。 它所做的是從目錄樹中的封閉文件中提取信息,並將該信息列入其自己的行中。獲取子目錄

有一件事我真的想這樣做並不能找出也是搶的文件路徑,並把那到相關行,比如像:

Sheets("Sheet1").Cells(r, 7).Value = gValue 'ie the file name 

隨着g值是文件路徑和名字。

我知道GetInfoFromClosedFile有什麼我想作爲wbFile的價值,但我不知道如何獲取到g值。我的編程技巧很平庸,請善待。我知道這不是簡單的說:

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 

回答

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

乾杯。我會在星期一試一試。 – user2552792

+0

感謝老闆,那是一種享受。 – user2552792