Look for multple extensions

[Dutchmaste]

I currently use the below macro. But as shown on line 7 & 15 this only looks for a filename with .xlsx
But unfortunatelly sometimes the extension of the files I receive change into either .xls, .xlsx or .xlsm
Due to this I currently have to edit the macro manually to look for the other extension. But I want it to do this automatically. But I can't seem to figure it out so it works for both actions on line 7 and 15.

Line1:    Dim curWorkbook As WorkbookLine2:    Set curWorkbook = ActiveWorkbook
Line3:    Application.AskToUpdateLinks = False
Line4:    Application.DisplayAlerts = False
Line5:    fName = curWorkbook.Sheets("HS Lijst").Range("K2")
Line6:    Sheets("DATA").Select
Line7:    Workbooks.Open FileName:="O:\Splitsen\" & fName & ".xlsx"
Line8:    Cells.Select
Line9:    Selection.Copy
Line10:    curWorkbook.Activate
Line11:    Cells.Select
Line12:    ActiveSheet.Paste
Line13:    Sheets("HS lijst").Select
Line14:    Range("C4").Select
Line15:    Windows(fName & ".xlsx").Activate
Line16:    Application.CutCopyMode = False
Line17:    ActiveWindow.Close
Line18:    Application.CutCopyMode = True
Line19:    curWorkbook.Activate
Line20:    Application.DisplayAlerts = True
Line21:    Application.AskToUpdateLinks = True

 

[RickXL]

Hi,

Something like this should work:

Sub Test()
    Dim fName        As String
    Dim curWorkbook  As Workbook
    
    Set curWorkbook = ActiveWorkbook
    Application.AskToUpdateLinks = False
    Application.DisplayAlerts = False
    fName = curWorkbook.Sheets("HS Lijst").Range("K2")
    fName = Dir("O:\Splitsen\" & fName & ".xls*")
    Sheets("DATA").Select
    Workbooks.Open Filename:="O:\Splitsen\" & fName
    Cells.Select
    Selection.Copy
    curWorkbook.Activate
    Cells.Select
    ActiveSheet.Paste
    Sheets("HS lijst").Select
    Range("C4").Select
    Windows(fName).Activate
    Application.CutCopyMode = False
    ActiveWindow.Close
    Application.CutCopyMode = True
    curWorkbook.Activate
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
End Sub

This line:

fName = Dir("O:\Splitsen\" & fName & ".xls*")

will search the folder using a wildcard and will return the first one found into the string fName.

Regards,