使用VBA打开FileDialog

Question

I download reports on a daily/weekly basis but when downloading the system auto generates the file name with a date at the end although the basic file name is the same. ie ANAPOS - 20141001. I'm using a simple open command (Workbooks.OpenText Filename:="C:\\Users\\903270\\Documents\\Excel\\ANAPOS.txt") to do some other stuff but before doing so I need to rename the file to ANAPOS.txt before I can run it. Is there any code that will allow my macro to search for ANAPOS with out all the other info at the end? Any help appreciated.

Answer 1

Set filePath to where you want to search

Sub getANAPOS()
Dim Filter As String, filePath As String

filePath = "C:\Data\VBA\SO\"
Filter = "ANAPOS files (*.txt), filepath & ANAPOS*.txt"

ANAPOSSelectedFile = Application.GetOpenFilename(Filter)

End Sub

EDIT FOLLOWING CLARIFICATION BY OP

Sticking with the same theme, this should give you some scope to work with. It essentially 'automatically' renames the selected file in situ, unless it already exists. Acknowledgements to @Gary's Student for his neat ideas to parse the GetOpenFileName result, here .

Sub renameANAPOS()
Dim Filter As String, filePath As String, newName As String

'filter txt file names containing 'ANAPOS'
Filter = "ANAPOS files (*.txt), filepath & ANAPOS*.txt"

'the 'rename' name
newfName = "ANAPOS"

'navigate to original ANAPOS file and location details
ANAPOSSelectedFile = Application.GetOpenFilename(Filter)

'parse selected file details
fullArr = Split(ANAPOSSelectedFile, "\")
detArr = Split(fullArr(UBound(fullArr)), ".")
fullArr(UBound(fullArr)) = ""
fPath = Join(fullArr, "\")
fName = detArr(0)
fExt = detArr(1)

'rename file in not already exixts
    If Len(Dir(fPath & newfName & "." & fExt)) > 0 Then
        MsgBox newfName & "." & fExt & " already exists in this folder."
        Exit Sub
    Else
        Name ANAPOSSelectedFile As fPath & newfName & "." & fExt
    End If

End Sub