Reputation: 27
I have a problem with a VBA code. The macro below is suppose to go to the destination folder which contains only Excel file but with different extension (xls, xlsx, xlsm) and loop over the exising files to find the larges number within the names of the files (the exaples of current files are DelKra 2021-()-162.xls; DelKra 2021-()-163.xls; DelKra 2021-()-164.xlsm). The macro run smoothly only when the destination folder contains xls Excel files but crashes whenever another type of Excel file is saved in the folder. The command the macro crashes at is: "CurrentNum = Mid(FileName, Len(FileName) - 6, 3)". Please help me to fix my macro.*
Sub ConfirmAndSaveDel()
DestinationFolder = "\\oscwawfs01.kingfisherasia.com.hk\common\FINANCE\Public\BUSINESS
TRIPS\Business Trip Delegacje\2021\Domestic\"
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
Dim LastNum As Integer
Dim CurrentNum As Integer
Dim Numerek As String
Dim whereTrip As String
Dim purposeTrip As String
Dim whoTrip As String
Dim startTrip As Date
Dim endTrip As Date
Dim LastRow As Integer
LastNum = 0
FileCount = 0
FileName = Dir(DestinationFolder)
'Loop searching all files
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
'Take from the file name numbers 6,5 i 4 counting from the right
CurrentNum = Mid(FileName, Len(FileName) - 6, 3)
'If it is larger than the current one remember it
If CurrentNum > LastNum Then
LastNum = CurrentNum
End If
'Debug.Print FileName
FileName = Dir()
Loop
'Add 1 to the largest number found
LastNum = LastNum + 1
'Debug.Print LastNum
'Change the numer to string and add as many zeros at the beginning of the number to have it as the three digit number
If Len(Trim(CStr(LastNum))) = 1 Then
Numerek = "00" & CStr(LastNum)
ElseIf Len(Trim(CStr(LastNum))) = 2 Then
Numerek = "0" & CStr(LastNum)
ElseIf Len(Trim(CStr(LastNum))) = 3 Then
Numerek = CStr(LastNum)
End If
'Combine the whole name of the new file
NazwaPliku = "DelKra 2021-" & "(" & Range("FRIFAR").Value & ")-" & Numerek
Upvotes: 0
Views: 52
Reputation: 42256
Try using such a function:
Function extractNumber(strName As String) As Long
Dim arr: arr = Split(strName, "-")
extractNumber = Split(arr(Ubound(arr)), ".")(0)
End Function
Copy the above function in the same module and call it as:
CurrentNum = extractNumber(fileName)
I mean, replace CurrentNum = Mid(FileName, Len(FileName) - 6, 3)
with the above way. It is independent of extension number of characters.
And besides that, please replace all declarations As Integer
with As Long
. In VBA that way of declaring does not bring any benefit in terms of memory handling or from any other point of view... It is good to cultivate such a habit in all cases. But if you like your way, please adapt the function to return As Integer
...
Upvotes: 0
Reputation: 29652
The following function will extract the part of the filename between the last dash and the last dot of the filename. If it is numeric, it will return that number, else (or if the filename doesn't follow the pattern) 0.
Function getFileNumber(filename As String) As Long
Dim pDash As Long, pDot As Long
pDash = InStrRev(filename, "-")
pDot = InStrRev(filename, ".")
If pDash = 0 Or pDot = 0 Or pDot < pDash Then Exit Function
Dim suffix As String
suffix = Mid(filename, pDash + 1, pDot - pDash- 1)
If IsNumeric(suffix) Then
getFileNumber = Val(suffix)
End If
End Function
Upvotes: 0