Vba 从一系列已关闭且名称不断更改的Excel工作簿中提取数据

因此，我有一个主工作簿（我们称之为工作簿一），它需要从一系列其他工作簿中提取单个单元格的数据，通常是百分比形式的数据，并在单击按钮时将其保存在列中。工作簿一中列出了另一个工作簿的路径。但是，路径是动态构建的。因此，工作簿名称是根据单元格A1中的输入构建的，例如：=A1&“.xlsx”，驱动器和文件夹路径按如下方式拉取：=N1&N2&N3，等等，这取决于文件夹数量和驱动器名称。所有的信息都会显示在一个单元格中，读取完整的路径，但是如果必要的话，我可以（并且已经）分别提取各个部分

我的最终目标是通过一个按钮激活一个宏，该按钮运行在工作簿列表中，从每个工作簿中提取一个单元格中的数据，并将其存放在工作簿中的一系列单元格中。此外，该列表可能包含空格，因此如果可能，跳过空白单元格。另外，我没有被这段代码困扰，所以如果你有更好的方法，请让我知道

当前我的代码如下所示：

Function dynamicPull()

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim sourceRange As Integer, inputRow As Integer, fepTotal As Integer
fepTotal = Range("EventList!F2").Value 'total number of events to run through
sourceRange = 2
inputRow = 3

Dim sourceFile As String, inputRange As String, pullRange As String, pullData As String
sourceFile = Range("Settings!Q" & sourceRange).Value 'currently unused
pullRange = Range("Settings!$N$23").Value 'cell to pull from in series of workbooks

Dim wbSource As Workbook, wbMain As Workbook
Set wbMain = ThisWorkbook

Dim sourceFile1 As String, sourceFile2 As String, sourceFile3 As String
sourceFile1 = Range("Settings!$N$26").Value 'pathing to workbook, ie C:\Folder1\Folder2\
sourceFile2 = Range("Settings!R" & sourceRange).Value 'workbook name
sourceFile3 = "Cover Sheet" 'sheet name

If fepTotal >= 1 Then
 checkedEvents = 0 'checkedEvents is dimmed in declarations
 error = 0
 For pullLoop = 1 To fepTotal
  sourceRange = 2
  inputRow = 3
  inputRange = "D" & inputRow 'where i want the pulled data to go
  sourceFile2 = Range("Settings!R" & sourceRange).Value 'workbook name
  pullData = GetValue(sourceFile1, sourceFile2, sourceFile3, pullRange)
  If pullData = "FnF" Then
   'wbMain.Sheets("EventList").Range(inputRange).Value = "FnF"
   GoTo FnF
  Else
   wbMain.Sheets("EventList").Range(inputRange).Value = pullData
   checkedEvents = checkedEvents + 1
  End If
FnF:
  inputRow = inputRow + 1 'shifts to next input cell (D4, D5, etc)
  sourceRange = sourceRange + 1 'shifts to next cell containing next document pathing
 Next pullLoop
Else
 error = MsgBox("No event inputs to derive from.", vbCritical, "ERROR")
 error = 1
End If

sourceRange = 2 'resets sourceRange to first pull cell
inputRow = 3
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

End Function

'Function GetValue(path, file, sheet, ref)
'   Retrieves a value from a closed workbook
'    Dim arg As String
'   Make sure the file exists
'    If Right(path, 1) <> "\" Then path = path & "\"
'    If Dir(path & file) = "" Then
'     GetValue = "FnF"
'     Exit Function
'    End If
'   Create the argument
'    arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
'     Range(ref).Range("A1").Address(, , xlR1C1)
'   Execute an XLM macro
'    GetValue = ExecuteExcel4Macro(arg)
'End Function

Function GetValue(ByVal sPath As String, sFile As String, _
              sSht As String, sRng As String) As Variant
' Retrieves a value from a closed workbook
' VBA only
Dim sArg As String

If Right(sPath, 1) <> "\" Then sPath = sPath & "\"

If Len(Dir(sPath & sFile)) Then 'Runtime error 52: Bad file name or number
    sArg = "'" & sPath & _
           "[" & sFile & "]" & _
           sSht & "'!" & _
           Application.ConvertFormula(sRng, xlA1, xlR1C1, True)
    GetValue = ExecuteExcel4Macro(sArg)
Else
    GetValue = "File not found"
End If
End Function

函数dynamicPull（）
Application.EnableEvents=False
Application.ScreenUpdating=False
Application.Calculation=xlCalculationManual
Dim sourceRange为整数，inputRow为整数，fepTotal为整数
fepTotal=范围（“EventList！F2”）。值“要运行的事件总数”
sourceRange=2
inputRow=3
Dim sourceFile作为字符串，inputRange作为字符串，pullRange作为字符串，pullData作为字符串
sourceFile=Range（“设置！Q”&sourceRange）。值“当前未使用”
pullRange=Range（“设置！$N$23”）。要从一系列工作簿中提取的“值”单元格
将wbSource作为工作簿，wbMain作为工作簿
设置wbMain=ThisWorkbook
将sourceFile1设置为字符串，将sourceFile2设置为字符串，将sourceFile3设置为字符串
sourceFile1=范围（“设置！$N$26”）。指向工作簿的“值”路径，即C:\Folder1\Folder2\
sourceFile2=Range（“Settings！R”&sourceRange）.Value“工作簿名称”
sourceFile3=“封面页”页名
如果fepTotal>=1，则
checkedEvents=0“checkedEvents在声明中变暗
错误=0
对于pullLoop=1到fepTotal
sourceRange=2
inputRow=3
inputRange=“D”&inputRow'我希望拉取的数据去哪里
sourceFile2=Range（“Settings！R”&sourceRange）.Value“工作簿名称”
pullData=GetValue（sourceFile1、sourceFile2、sourceFile3、pullRange）
如果pullData=“FnF”，则
'wbMain.Sheets（“事件列表”）.Range（inputRange）.Value=“FnF”
转到FnF
其他的
wbMain.Sheets（“EventList”）.Range（inputRange）.Value=pullData
checkedEvents=checkedEvents+1
如果结束
FnF：
inputRow=inputRow+1'移动到下一个输入单元（D4、D5等）
sourceRange=sourceRange+1'移动到包含下一个文档路径的下一个单元格
下一个pullLoop
其他的
error=MsgBox（“无可派生的事件输入。”，vbCritical，“error”）
错误=1
如果结束
sourceRange=2'将sourceRange重置为第一个提取单元
inputRow=3
Application.Calculation=xlCalculationAutomatic
Application.ScreenUpdating=True
Application.EnableEvents=True
端函数
'函数GetValue（路径、文件、工作表、参考）
'从关闭的工作簿中检索值
'Dim arg作为字符串
'确保该文件存在
“如果正确（路径，1）”\“则路径=路径&”
'如果目录（路径和文件）=''，则
'GetValue=“FnF”
'退出功能
"完"
'创建参数
'arg=“”&path&“[”&file&“]”&sheet&“！”&_
'范围（参考）。范围（“A1”）。地址（，xlR1C1）
'执行XLM宏
'GetValue=ExecuteExcel4Macro（arg）
'结束函数
函数GetValue（ByVal sPath作为字符串，sFile作为字符串_
sSht作为字符串，sRng作为字符串）作为变量
'从关闭的工作簿中检索值
“仅限VBA
暗色纱布
如果正确（sPath，1）“\”则sPath=sPath&“\”
如果是Len（Dir（sPath&sFile）），则“运行时错误52:错误的文件名或编号”
sArg=“””&sPath&_
“[”&sFile&“]”&_
sSht&“！”和_
应用公式（sRng，xlA1，xlR1C1，真）
GetValue=ExecuteExcel4Macro（sArg）
其他的
GetValue=“未找到文件”
如果结束
端函数

我还发现了其他一些可能有用的帖子：

---

我已经为此奋斗了相当长的一段时间，非常感谢所有的帮助。我会尽快回答任何问题，提供任何反馈等。再次感谢。

工作代码如下：

Function dynamicPull()

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim sourceRange As Integer, inputRow As Integer, fepTotal As Integer
fepTotal = Range("EventList!F2").Value

Dim inputRange As String, pullRange As String, pullData As String
pullRange = Range("Settings!$N$23").Value

Dim wbSource As Workbook, wbMain As Workbook
Set wbMain = ThisWorkbook

Dim sourceFile1 As String, sourceFile2 As String, sourceFile3 As String
sourceFile1 = Range("Settings!$N$26").Value 'pathing to workbook, ie C:\Folder1\Folder2\
sourceFile3 = "Cover Sheet" 'sheet name

If fepTotal >= 1 Then
 checkedEvents = 0
 error = 0
 For pullLoop = 1 To fepTotal
 If pullLoop = 1 Then
  sourceRange = 2
  inputRow = 3
 End If
 inputRange = "D" & inputRow
 sourceFile2 = Range("Settings!R" & sourceRange).Value 'workbook name
 pullData = GetValue(sourceFile1, sourceFile2, sourceFile3, pullRange)
 If pullData = "FnF" Then
  GoTo FnF
 Else
 wbMain.Sheets("EventList").Range(inputRange).Value = pullData
 checkedEvents = checkedEvents + 1
End If
FnF:
 inputRow = inputRow + 1
 sourceRange = sourceRange + 1
Next pullLoop
Else
 error = MsgBox("No event inputs to derive from.", vbCritical, "ERROR")
 error = 1
End If

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

End Function

Function GetValue(ByVal sPath As String, sFile As String, _
              sSht As String, sRng As String) As Variant
' Retrieves a value from a closed workbook
' VBA only
Dim sArg As String

If Right(sPath, 1) <> "\" Then sPath = sPath & "\"

If Len(Dir(sPath & sFile)) Then
    sArg = "'" & sPath & _
           "[" & sFile & "]" & _
           sSht & "'!" & _
           Application.ConvertFormula(sRng, xlA1, xlR1C1, True)
    GetValue = ExecuteExcel4Macro(sArg)
Else
    GetValue = "NO DATA"
End If
End Function

函数dynamicPull（）
Application.EnableEvents=False
Application.ScreenUpdating=False
Application.Calculation=xlCalculationManual
Dim sourceRange为整数，inputRow为整数，fepTotal为整数
fepTotal=范围（“事件列表！F2”）。值
Dim inputRange为字符串，pullRange为字符串，pullData为字符串
pullRange=范围（“设置！$N$23”）。值
将wbSource作为工作簿，wbMain作为工作簿
设置wbMain=ThisWorkbook
将sourceFile1设置为字符串，将sourceFile2设置为字符串，将sourceFile3设置为字符串
sourceFile1=范围（“设置！$N$26”）。指向工作簿的“值”路径，即C:\Folder1\Folder2\
sourceFile3=“封面页”页名
如果fepTotal>=1，则
checkedEvents=0
错误=0
对于pullLoop=1到fepTotal
如果pullLoop=1，则
sourceRange=2
inputRow=3
如果结束
inputRange=“D”&inputRow
sourceFile2=Range（“Settings！R”&sourceRange）.Value“工作簿名称”
pullData=GetValue（sourceFile1、sourceFile2、sourceFile3、pullRange）
如果pullData=“FnF”，则
转到FnF
其他的
wbMain.Sheets（“EventList”）.Range（inputRange）.Value=pullData
checkedEvents=checkedEvents+1
如果结束
FnF：
inputRow=inputRow+1
sourceRange=sourceRange+1
下一个pullLoop
其他的
error=MsgBox（“无可派生的事件输入。”，vbCritical，“error”）
错误=1
如果结束
Application.Calculation=xlCalculationAutomatic
Application.ScreenUpdating=True
Application.EnableEvents=True
端函数
函数GetValue（ByVal sPath作为字符串，sFile作为字符串_
sSht作为字符串，sRng作为字符串）作为变量
'从中检索值