在Excel VBA中从绝对工作簿引用更改为相对工作簿引用

我编写了一个Excel VBA宏，它将位于特定文件夹中的各种电子表格中的所有信息编译成一个“主”Excel工作簿

目前，在我的计算机上使用它时，它可以正常工作，但我想调整代码，以便我可以将“主”电子表格和包含单个电子表格（要编译的电子表格）的文件夹放置在网络驱动器上，以便任何人都可以使用它

我对VBA和一般的编码是相当陌生的，所以我有一种强烈的感觉，可能有一个简单的解决方案来解决我的问题

我已附加运行绝对引用的当前宏

'Summary:    Open all Excel files in a specific folder and merge data
'            into one master sheet (stacked)

Dim fName As String, fPath As String, fPathDone As String, OldDir As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wbkNew As Workbook

'Setup
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

Set wbkNew = ThisWorkbook
wbkNew.Activate
Sheets("Master").Activate

If MsgBox("Import new data to this report?", vbYesNo) = vbNo Then Exit Sub

If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
    Cells.Clear
    NR = 1
Else
    NR = Range("A" & Rows.Count).End(xlUp).Row + 1
End If


fPath = "C:\Folder-that-Excel-workbooks-are-located-in"
On Error Resume Next
    MkDir fPathDone
On Error GoTo 0
OldDir = CurDir
ChDir fPath
fName = Dir("*.xlsx")


Do While Len(fName) > 0
    If fName <> wbkNew.Name Then

        Set wbData = Workbooks.Open(fName)



        LR = Range("C" & Rows.Count).End(xlUp).Row
        If NR = 1 Then
            Range("C5:F" & LR).EntireRow.Copy _
                wbkNew.Sheets("Master").Range("A" & NR)
        Else
            Range("C5:F" & LR).EntireRow.Copy _
                wbkNew.Sheets("Master").Range("A" & NR)
        End If

        wbData.Close False

        NR = Range("C" & Rows.Count).End(xlUp).Row + 1

        fName = Dir
    End If
Loop

ErrorExit:
ActiveSheet.Columns.AutoFit
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
ChDir OldDir  

”摘要：打开特定文件夹中的所有Excel文件并合并数据
'放入一张母版纸（堆叠）
Dim fName作为字符串、fPath作为字符串、fPathDone作为字符串、OldDir作为字符串
尺寸LR与长度相同，NR与长度相同
将wbData作为工作簿，wbData作为工作簿
"设置",
Application.ScreenUpdating=False
Application.EnableEvents=False
Application.DisplayAlerts=False
设置wbknowed=此工作簿
我知道，激活
工作表（“主控”）。激活
如果MsgBox（“是否将新数据导入此报表？”，vbYesNo）=vbNo，则退出Sub
如果MsgBox（“先清除旧数据？”，vbYesNo）=vbYes，则
牢房，没问题
NR=1
其他的
NR=范围（“A”和行数）。结束（xlUp）。行数+1
如果结束
fPath=“C:\Excel工作簿所在的文件夹”
出错时继续下一步
MkDir fpathtone
错误转到0
OldDir=CurDir
ChDir-fPath
fName=Dir（“*.xlsx”）
当Len（fName）>0时执行
如果fName知道。那么名称
设置wbData=Workbooks.Open（fName）
LR=范围（“C”和Rows.Count）.End（xlUp）.Row
如果NR=1，则
范围（“C5:F”和LR）.EntireRow.Copy_
WBS图纸（“主”）范围（“A”和NR）
其他的
范围（“C5:F”和LR）.EntireRow.Copy_
WBS图纸（“主”）范围（“A”和NR）
如果结束
wbData.Close False
NR=范围（“C”和行数）。结束（xlUp）。行数+1
fName=Dir
如果结束
环
错误退出：
ActiveSheet.Columns.AutoFit
Application.DisplayAlerts=True
Application.EnableEvents=True
Application.ScreenUpdating=True
ChDir OldDir

一个快速而肮脏的解决方案是将工作簿文件夹的路径放在主工作簿的某个位置

将其他工作簿放在网络共享上，该网络共享可用于与您共享excel工作表的所有计算机。使用如下所示的UNC路径：

\\ComputerName\SharedFolder\Resource

excelfolder=\\ComputerName\SharedFolder\Resource

然后可以将代码中的fPath设置为cells值

更好的方法是将路径放入与主工作簿位于同一文件夹中的设置文件中，并在运行宏时读取路径：

Dim tmpArray() As String
Dim s As String
Dim strPath as String
Open ThisWorkbook.Path & "\settings.ini" For Input As #1
    Do While Not EOF(1)
        Line Input #1, s
        If VBA.Left(s, 11) = "excelfolder" Then
            tmpArray = Split(s, "=")
            strPath = tmpArray(1)
        End If
    Loop
Close #1

您的ini文件如下所示：

\\ComputerName\SharedFolder\Resource

excelfolder=\\ComputerName\SharedFolder\Resource