Make Copy of File Before Extension Change

[erock24]

I have code that I use to convert a file to a .xls file...It works great. I was wondering though if it were possible to add code to this so that it makes a copy of the file as is before it changes the extension..

TheFile = Application.GetOpenFilename("LOD Load Files (*.LOD), *.LOD", , "Open LOD File")
    If TheFile = "False" Then
      Exit Sub
    End If
    
      Oldfilename = TheFile
    ' Separate the file path and file name
      BS = InStrRev(Oldfilename, "\")
      Oldfilepath = Left(Oldfilename, BS)
      Newfilename = Right(Oldfilename, Len(Oldfilename) - BS)
    ' Add the XLS extension to the file name
      Dot = InStr(1, Newfilename, ".")
      Newfilename = Oldfilepath & Left(Newfilename, Dot) & "xls"
    ' Rename the file
      Name Oldfilename As Newfilename
    Workbooks.Open Filename:=Newfilename

Thanks,

 

[erock24]

I've got it figured out.....found some code and was able to edit.

 TheFile = Application.GetOpenFilename("LOD Load Files (*.LOD), *.LOD", , "Open LOD File")
    If TheFile = "False" Then
      Exit Sub
    End If
    
'Create Copy of file
    Dim fso As Object
    Set fso = CreateObject("scripting.FileSystemObject")
     'Get a handle to the file
    Set f = fso.GetFile(TheFile)
    ' Copy the file
    f.Copy (TheFile & "Copy.LOD")
    
'Covert file from .LOD to .XLS
      Oldfilename = TheFile
    ' Separate the file path and file name
      BS = InStrRev(Oldfilename, "\")
      Oldfilepath = Left(Oldfilename, BS)
      Newfilename = Right(Oldfilename, Len(Oldfilename) - BS)
    ' Add the CSV extension to the file name
      Dot = InStr(1, Newfilename, ".")
      Newfilename = Oldfilepath & Left(Newfilename, Dot) & "xls"
    ' Rename the file
      Name Oldfilename As Newfilename
    Workbooks.Open Filename:=Newfilename