Блог

У меня есть 50 файлов, которые в разной степени связаны друг с другом. Каждый месяц все файлы должны быть перемещены в другую папку (новый выпуск) с обновленными именами, чтобы отразить новый месяц (т.е. Продажи 445F — 06-2019 к продажам 446F — 07-2019).

Для этого, я считаю, мне нужно открыть все 50 файлов перед переименованием, чтобы ссылки были обновлены до нового имени и нового расположения файла.

Ниже приведен созданный мной макрос, в котором отображается столбец, идентифицирующий файлы, которые нужно открыть, а затем второй столбец, который идентифицирует новое имя файла.

Хотя макрос создает новые файлы в нужном месте с правильными именами, все созданные файлы одинаковы (последний открытый файл), и ссылки по-прежнему остаются прикрепленными к старым именам файлов и местоположениям. Предложения?

 Private Sub CommandButton1_Click()
For i = 10 To 59

pathname = Range("B5").Value
Filename = Range("B" amp; i).Value

Application.AskToUpdateLinks = False
Application.DisplayAlerts = False

Workbooks.Open Filename:=pathname amp; Filename

Next i

MsgBox ("All Files Have Been Opened")

For i = 10 To 59

pathname2 = Range("C5").Value
filename2 = Range("C" amp; i).Value

ActiveWorkbook.SaveAs Filename:=pathname2 amp; 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 
  

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" amp; i).Value
    
        Application.AskToUpdateLinks = False
        Application.DisplayAlerts = False
        
        Set wbOpen(i) = Workbooks.Open(FileName:=PathName amp; 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" amp; i).Value
    
        wbOpen(i).SaveAs FileName:=PathName amp; 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