重命名文件-仅在全部打开后(以确保链接更新到新文件的位置和名称)

Question

我有50个文件，它们在不同程度上相互链接。每个月，所有文件都必须移动到具有更新名称的不同文件夹(新版本(中，以反映新月份(即Sales 445F-06-2019到Sales 446F-07-2019(。

要做到这一点，我相信我需要在重命名之前打开所有50个文件，这样链接就会更新到新名称和新文件位置。

下面是我创建的宏，它去掉了一列标识要打开的文件，然后又去掉了第二列标识文件的新名称。

尽管宏使用正确的名称在正确的位置创建新文件，但创建的文件都是相同的(最后打开的文件(，并且链接仍然附着在旧的文件名和位置上。建议？

Private Sub CommandButton1_Click()
For i = 10 To 59
pathname = Range("B5").Value
Filename = Range("B" & i).Value
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Workbooks.Open Filename:=pathname & Filename
Next i
MsgBox ("All Files Have Been Opened")
For i = 10 To 59
pathname2 = Range("C5").Value
filename2 = Range("C" & i).Value
ActiveWorkbook.SaveAs Filename:=pathname2 & filename2
Next i
MsgBox ("All Files Have Been Saved in the New Folder. A Final Save to Update Links to Point to the New Folder Will Now Begin")
Dim wb As Workbook
Dim wbStayOpen1 As String
Dim currentwb As String

wbStayOpen1 = "C:UsersDesktopCustom MacrosOpen Rename and Save to New Folder.xlsm"
currentwb = ThisWorkbook.Name

For Each wb In Workbooks

If wb.Name <> wbStayOpen1 And wb.Name <> currentwb Then

wb.Close SaveChanges:=True
End If

Next wb
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
End Sub 

Answer 1

1. 它总是保存完全相同的工作簿，因为您使用ActiveWorkbook.SaveAs，并且活动工作簿永远不会更改。避免使用ActiveWorkbook。相反，将所有工作簿设置为打开的工作簿wbOpen(iStart To iEnd)的数组，然后在第二个循环中可以轻松访问该数组。也可以在第三个循环中使用它来关闭它们。

2. 永远不要给变量名编号。这是一种非常糟糕的做法，如果你认为你需要这样做，那你就做错了。实际上，不需要声明pathname2和filename2，您可以重用第一个变量。

Option Explicit
Private Sub CommandButton1_Click() 'make sure to give it a proper name
Dim wsSource As Worksheet
Set wsSource = ThisWorkbook.ActiveSheet 'better declare sheet name like `ThisWorkbook.Worsheets("Sheet1")

'if the start and end is dynamic make them variables instead of constants
Const iStart As Long = 10
Const iEnd As Long = 59

ReDim wbOpen(iStart To iEnd) As Workbook

Dim PathName As String
Dim FileName As String

'open workbooks
Dim i As Long
For i = iStart To iEnd
PathName = wsSource.Range("B5").Value
FileName = wsSource.Range("B" & i).Value

Application.AskToUpdateLinks = False
Application.DisplayAlerts = False

Set wbOpen(i) = Workbooks.Open(FileName:=PathName & FileName)
Next i

MsgBox ("All Files Have Been Opened")

'save workbooks
For i = iStart To iEnd
PathName = wsSource.Range("C5").Value
FileName = wsSource.Range("C" & i).Value

wbOpen(i).SaveAs FileName:=PathName & FileName
Next i

MsgBox ("All Files Have Been Saved in the New Folder.")

'close workbooks
For i = iStart To iEnd
wbOpen(i).Close SaveChanges:=True
Next i
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
End Sub