Excel VB; find, copy, and rename file problem

[govern]

Hi, I am relatively new to Excel VB and have been stumped. I need help writing code that finds a file of any type e.g. (xls, xlsx, doc, docx, ppt, txt) copies and renames it with the appropriate extension to another specified folder. In addition, the user will not be allowed to find the file to be copied, rather the file must be found using code to search for a known text string within the file's name in a specified folder (assuming only one file has the text string within that folder). As this workbook needs to be readily distributable to unskilled users it can not require adding references manually or programmatically.
I would surely appreciate any advice or help on this matter, thanks very much

 

[govern]

never mind, here's what I came up with...

Private sub nuttin()

Dim TemplateFileName As String
Dim Currentpath As String
Dim TargetPath As String
Dim FileNameExtension As String
Dim FullPathName As String
Dim ManifestTemplateFileNameExtension As String
Dim MTFNE As String, RTFNE As String
Dim DirectoryFolder As String
Dim RouteClearanceDirectory As String

RouteClearanceDirectory = "C:\RouteClearance" ' this should eventually reference a sheet cell
' whereby the user can change the root directory of the system

ManifestLine: 'linelabel

DirectoryFolder = "\MissionManifest" ' this must change for
TargetPath = RouteClearanceDirectory & DirectoryFolder

TemplateFileName = Dir(TargetPath & "\TEMPLATE*") ' wildcard path search for template existence
If TemplateFileName = "" Then
MsgBox ("There was no template file found")
GoTo ReportLine
End If
FullPathName = TargetPath & "\" & TemplateFileName

' calls function GetFileExtension which extracts the extension name from the TemplateFileName
ManifestTemplateFileNameExtension = GetFileExtension(FullPathName)
MTFNE = ManifestTemplateFileNameExtension

' takes template and creates copy by specified name in same directory
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile FullPathName, TargetPath & "\" & PLT & "_" & DD & SPTM & "C" & MMM & YY & _
"_MISSION_MANIFEST." & MTFNE

' establishes hyperlinks in the sheet .....needs refinement
AddressString = TargetPath & "\" & PLT & "_" & DD & SPTM & "C" & MMM _
& YY & "_MISSION_MANIFEST." & MTFNE
r1.Cells(1, 6).Select ' cells where report hyperlink should go
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=AddressString


ReportLine: 'linelabel

DirectoryFolder = "\MissionReport" ' this must change for
TargetPath = RouteClearanceDirectory & DirectoryFolder

TemplateFileName = Dir(TargetPath & "\TEMPLATE*") ' wildcard path search for template existence
If TemplateFileName = "" Then
MsgBox ("There was no template file found")
GoTo AddFileFinishedLine ' change for additional templates
End If
FullPathName = TargetPath & "\" & TemplateFileName

' calls function GetFileExtension which extracts the extension name from the TemplateFileName
ReportTemplateFileNameExtension = GetFileExtension(FullPathName)
RTFNE = ReportTemplateFileNameExtension

' takes template and creates copy by specified name in same directory
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile FullPathName, TargetPath & "\" & PLT & "_" & DD & SPTM & "C" & MMM & YY & _
"_PATROL_REPORT." & RTFNE

' establishes hyperlinks in the sheet .....needs refinement
AddressString = TargetPath & "/" & PLT & "_" & DD & SPTM & "C" & MMM _
& YY & "_PATROL_REPORT." & RTFNE
r1.Cells(1, 22).Select ' cells where report hyperlink should go
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=AddressString
r1.Cells(1, 22).Value = PLT & "_" & DD & SPTM & "C" & MMM & YY & "_PATROL_REPORT." & RTFNE

AddFileFinishedLine: 'linelabel indicating completion of support file addition routine


Range("F9").Select
Call Protector

End Sub

Public Function GetFileExtension(ByVal Path As String) As String
Dim I As Integer
For I = Len(Path) To 1 Step -1
If Mid(Path, I, 1) = "." Then Exit For
Next I

GetFileExtension = Right(Path, Len(Path) - I)
End Function