使用VBA打開FileDialog

Question

我每天/每周下載報告，但下載時系統會自動生成文件名，但文件名的末尾帶有日期，盡管基本文件名相同。 即ANAPOS-20141001。我正在使用一個簡單的打開命令（Workbooks.OpenText文件名：=“ C：\\ Users \\ 903270 \\ Documents \\ Excel \\ ANAPOS.txt”）來執行其他操作，但在此之前，我需要重命名我可以先將文件保存到ANAPOS.txt。 是否有任何代碼可讓我的宏搜索ANAPOS，而最后沒有其他所有信息？ 任何幫助表示贊賞。

Answer 1

將filePath設置到要搜索的位置

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

通過OP編輯說明

堅持相同的主題，這應該給您一些工作空間。 除非已存在，否則它基本上是“自動”在原位重命名所選文件。 致謝改為@加里的學生，他巧妙的想法來解析GetOpenFileName結果， 在這里 。

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