用VBA列出檔案所有資訊

以下VBA會列出所有檔案資訊

(不論是否該檔有沒有開啟,都可以得到正確檔案資訊)

Sub getDetailsOfFile()
Dim myShl As New Shell
Dim curFolder As Folder
Dim theItm As FolderItem
Dim Fn As Variant
Dim theTitle As String
Dim outStr As String
Dim i As Long
Fn = Application.GetOpenFilename
If Fn = "False" Then Exit Sub
Set curFolder = myShl.Namespace(CurDir)
Fn = Split(Fn, "\"): Fn = Fn(UBound(Fn))
With curFolder
theTitle = .GetDetailsOf(0, i)
Do While theTitle <> ""
outStr = outStr & theTitle & ": " & vbTab & .GetDetailsOf(.Items.Item(Fn), i) & vbCrLf
Debug.Print i & .GetDetailsOf(.Items.Item(Fn), i)
i = i + 1
theTitle = .GetDetailsOf(0, i)
Loop
End With
Set myShl = Nothing
MsgBox outStr
End Sub

請設定引用項目Microsoft Shell Controls and Automation
VBE=>工具=>設定引用項目=>勾選Microsoft Shell Controls and Automation

問題: 如何不開啟*.xls而直接讀取其資料?

可用ExecuteExcel4Macro函數!
以下VBA可直接讀入[A1:E16]所有的資料到目前的工作表.

Sub GetExcelCell()
Dim arg As String
fl = Application.GetOpenFilename("*.xls (*.xls), *.xls", MultiSelect:=False)
If fl = False Then End
p = Left(fl, InStrRev(fl, "\"))
f = Right(fl, Len(fl) - InStrRev(fl, "\"))
s = "Sheet1" '請自行修改sheet名稱!
For r = 1 To 16
For c = 1 To 5
a = Cells(r, c).Address
Cells(r, c) = GetValue(p, f, s, a)
Next c
Next r
End Sub

Private Function GetValue(path, file, sheet, ref)
Dim arg As String
arg = "'" & path & "[" & file & "]" & sheet & "'!" & Range(ref).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function