Sub Test()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim strOldData As String
Dim strNewData As String
Dim strKolFil As String

Dim fs As New FileSystemObject
  Dim fl As Folder
  Dim fls As Files
  Dim f As File
  Dim fn As String
  'On Error Resume Next
  fn = "D:\Temp"
  Set fl = fs.GetFolder(fn)
  Set fls = fl.Files
  
  Set cnn = CurrentProject.Connection
  Set rst = New ADODB.Recordset

  rst.Open "tblCode", cnn, adOpenKeyset, adLockOptimistic, adCmdTable

  For Each f In fls
  strOldData = Mid(f.Name,  11 ,  6 )
  strNewData = Mid(strOldData,  3 )
  strKolFil = Mid(f.Name,  18 )
    
  While Not rst.EOF
  Name fn & "RUM_" & rst("Spro") & "_" & strOldData & "_" & strKolFil _
  As fn & "RUM" & strNewData & rst("Soun") & "_" & strKolFil
  
  rst.MoveNext
  Wend
    
  Next

rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
End Sub

Name fn & "RUM" & "_" & rst("Spro") & "_" & strOldData & "_" & strKolFil _
  As fn & "RUM" & strNewData & rst("Soun") & "_" & strKolFil