VBA code to change date in workbook links - excel

Question

In a workbook I have links to another workbook from which it gathers some info. The link contains month number (09,10,11..); month name (Sep,Oct,Nov) and year. I am trying to make a VBA code which would change the dates in the external link to the present values. After it updates link. In case of an error (it couldn't find files using the link) code takes previous dates and loops until the link is working. For example, now it Oct 10 2021, but the code can't find the file it should take Sep 9 2021 and if this link didn't work it takes Aug 8 2021 and etc. Another problem is local of the date. I have to take en-US local for the month name, but I couldn't manage to do this.
I have a code below which is an attempt to do these operations. Thank you for your help in advance!
Sub changeLinks()
Dim link, linkSources, newLink As String
Dim today As Date
Dim monthname As Date
Dim monthnumber As Date
Dim yr As Date
today = Now()
'monthname = Format(Now(), "[$-en-US]MMM;#")
monthnumber = Format(today, "mm")
yr = Format(Now(), "yyyy")
newLink = "https:linklinklink" _
& yr & "/" & monthnumber & "_" & monthname & "/Report" & monthnumber & ".xlsx"
linkSources = ThisWorkbook.linkSources(xlLinkTypeExcelLinks)
If IsArray(linkSources) Then
For Each link In linkSources
'If InStr(link, "test1.xls") Then _'
ThisWorkbook.ChangeLink link, newLink, xlLinkTypeExcelLinks
Next
End If
On Error GoTo pvDate
ThisWorkbook.UpdateLink Name:=ThisWorkbook.linkSources
Exit Sub
pvDate:
monthname = WorksheetFunction.EDate(Format(Now(), "[$-en-US]mmm;#"), 1)
monthnumber = WorksheetFunction.EDate(Format(Now(), "mm"), 1)
yr = WorksheetFunction.EDate(Format(Now(), "yyyy"), 1)
newLink = "https:linklinklink" _
& yr & "/" & monthnumber & "_" & monthname & "/Report" & monthnumber & ".xlsx"
linkSources = ThisWorkbook.linkSources(xlLinkTypeExcelLinks)
If IsArray(linkSources) Then
For Each link In linkSources
'If InStr(link, "test1.xls") Then _'
ThisWorkbook.ChangeLink link, newLink, xlLinkTypeExcelLinks
Next
End If
ThisWorkbook.UpdateLink Name:=ThisWorkbook.linkSources
End Sub

Answer 1

This repeatedly checks if the newlink file can be opened before either giving up or, if successful, proceeding to update the links. I assume you want the month names to be independent of the locale so I have put them in an array.
Option Explicit
Sub changeLinks()
Const URI = "https:linklinklink"
Const MAX_TRY = 5
Dim mthname
mthname = Array("", "Jan", "Feb", "Mar", "Apr", "May", "Jun", _
"Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
Dim links, link, newlink As String, msg As String
Dim wb As Workbook, wblink As Workbook
Set wb = ThisWorkbook
links = wb.LinkSources(xlLinkTypeExcelLinks)
If Not IsArray(links) Then
MsgBox "No links to update", vbCritical
Exit Sub
End If
' determine latest link
Dim dt As Date, n As Long, m As Integer, bOK As Boolean
dt = Date
Do While Not bOK
m = Month(dt)
newlink = URI & Format(dt, "yyyy/m_") & mthname(m) & "/Report" & m & ".xlsx"
msg = msg & vbCrLf & newlink
On Error Resume Next
Set wblink = Workbooks.Open(newlink, 0, 1)
If wblink Is Nothing Then
' previous month
dt = DateAdd("m", -1, dt)
Else
wblink.Close False
bOK = True
End If
On Error GoTo 0
' limit attempts
n = n + 1
If n > MAX_TRY Then
MsgBox MAX_TRY & " attempts, giving up " & msg, vbExclamation
Exit Sub
End If
Loop
' update links
If bOK Then
n = 0
For Each link In LinkSources
wb.ChangeLink link, newlink, xlLinkTypeExcelLinks
n = n + 1
Next
wb.UpdateLink Name:=wb.LinkSources
MsgBox n & " links updated to " & newlink, vbInformation
End If
End Sub