在Excel VBA中從絕對變爲相對工作簿參考

我已經編寫了一個Excel VBA宏，它彙編了位於特定文件夾中的各種電子表格的所有信息，並將它們編譯到一個「主」Excel工作簿中。在Excel VBA中從絕對變爲相對工作簿參考

目前在我的計算機上使用它時工作正常，但我想調整代碼，以便我可以在網絡上放置「主」電子表格和包含單個電子表格（要編譯的電子表格）的文件夾驅動器，以便任何人都可以使用它。

我對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

來源

2011-07-18 Ryan Woltz

一個快速而骯髒的解決方案是將工作簿文件夾的路徑放入主工作簿。

將其他工作簿放在一個網絡共享上，該共享可用於您與之共享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

來源

2011-07-18 19:00:21 Jacob

在Excel VBA中從絕對變爲相對工作簿參考

回答

相關問題