Question

我编写了一个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

Answer 1

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

将其他工作簿放在网络共享上，该共享可供与您共享Excel工作表的所有计算机使用。使用这样的UNC路径：

\\ComputerName\SharedFolder\Resource

然后，您可以在代码中将fPath设置为单元格值。

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

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文件如下所示：

excelfolder=\\ComputerName\SharedFolder\Resource

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

1 个答案: