Excel_VbA_读取某个文件夹下所有文件的内容

Excel VbA 读取某个文件夹下所有文件的内容Sub GetAFolderMoreWorkBooks()

Dim fPath As String ‘路径名

Dim fName As String ‘文件名

Dim sName As String ‘工作表名称

Dim cellRange As String ‘单元格范围

Dim fNameCount As Integer ‘文件数目

Dim fNameList() As String ‘文件名列表

Dim rValue As Variant ‘某个单元格中的值

Dim j As Integer

Dim oldCol As Integer ‘文件夹下表格的活动单元格

Dim newCol As Integer ‘新生成表格的活动单元格j = 1

oldCol = 11

newCol = 1

fPath = "C:￥Documents and Settings￥USER￥デスクトップ￥check"

sName = "レビュー記録"

fName = Dir(fPath & "￥" & "*.xls")

While fName <> "" ‘获取该文件夹下所有表格的名字

fNameCount = fNameCount + 1

ReDim Preserve fNameList(1 To fNameCount)

fNameList(fNameCount) = fName

fName = Dir

Wend

Workbooks.Add

If fNameCount = 0 Then Exit Sub

rValue = 1

For j = 1 To fNameCount

oldCol = 11

rValue = 1

While rValue <> 0

oldRange = "A" & oldCol & ":P" & oldCol

newRange = "B" & newCol & ":R" & newCol

Cells(newCol, 1).Formula = fNameList(j)

'MsgBox "fNameList:" & fNameList(j)

If rValue <> 0 Then

With ActiveSheet.Range(newRange)

.FormulaArray = "='" & fPath & "￥[" & fNameList(j) & "]" & sName & "'!" & oldRange

.Value = .Value

End With

End If

oldCol = oldCol + 1

newCol = newCol + 1

rValue = ExecuteExcel4Macro("'" & fPath & "￥[" & fNameList(j) & "]" & sName & "'!" & Range("a" & oldCol).Range("A1").Address(, , xlR1C1))

Wend

Next j

End Sub