如何用VBA打开选择文件和选择路径的对话框

'注意引用　microsoft　office 10.0 （或以上）　object library

'在文件对话框对中圆清如返回选择一个文件夹的路径.

Public Function ChooseFolder() As String

Dim dlgOpen As FileDialog

Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker)

With dlgOpen

If .Show = -1 Then

ChooseFolder = .SelectedItems(1)End IfEnd With

Set dlgOpen = Nothing

End Function

'--------------------------------------------------------

'在文件对话框对中，选择一个文件。

Public Function ChooseOneFile(Optional TitleStr As String

= 选择你要的文件, Optional TypesDec As String = 所正衡有文件,

Optional Exten As String = *.*) As String

Dim dlgOpen As FileDialog

Set dlgOpen = Application.FileDialog(msoFileDialogFilePicker)

With dlgOpen

.Title = TitleStr

.Filters.Clear'清除所有的文件类型.

.Filters.Add TypesDec, Exten

.AllowMultiSelect = False '不能多选.

If .Show = -1 Then

'.AllowMultiSelect = True '多个文件

'For Each vrtSelectedItem In .SelectedItems

'MsgBox Path name:& vrtSelectedItem

'橘启Next vrtSelectedItem

ChooseOneFile = .SelectedItems(1)'第一个文件End IfEnd With

代码如下：

Sub GetFile()

    Dim FolderPicker As Object

    Dim FilePath As String

    Set FolderPicker = Application.FileDialog(msoFileDialogFilePicker)

    With FolderPicker

        .Filters.Clear

        .Filters.Add "文本文件", "*.txt"

    逗烂凳    If .Show = -1 Then

    历槐            FilePath = .SelectedItems(1)

        Else

           山旅 Exit Sub

        End If

    End With

End Sub

【引用位置】 https://blog.csdn.net/pashine/article/details/42100237

'-------------------------------------------

'获取某文件夹下的所有Excel文件

'-------------------------------------------

Sub getExcelFile(sFolderPath As String)

On Error Resume Next

Dim f As String

Dim file() As String

Dim x

k = 1

ReDim file(1)

file(1) = sFolderPath &""

End Sub

'-------------------------------------------

'获取某文件夹下的所有文件和子扰者好目录下的文件

'-------------------------------------------

Sub getAllFile(sFolderPath As String)

'Columns(1).Delete

On Error Resume Next

Dim f As String

Dim file() As String

Dim i, k, x

x = 1

i = 1

k = 1

ReDim file(1 To i)

file(1) = sFolderPath &""

'-- 获得所有子目录

Do Until i >k

f = Dir(file(i), vbDirectory)

Do Until f = ""

If InStr(f, ".") = 0 Then

k = k + 1

ReDim Preserve file(1 To k)

file(k) = file(i) &f &""

End If

f = Dir

Loop

i = i + 1

Loop

'-- 获得所有子目录下的所有文件

For i = 1 To k

f = Dir(file(i) &" . ")'通嫌塌配符 . 表示所有文件，*.xlsx Excel文件

Do Until f = ""

'Range("a" &x) = f

Range("a" &x).Hyperlinks.Add Anchor:=Range("缓铅a" &x), Address:=file(i) &f, TextToDisplay:=f

x = x + 1

f = Dir

Loop

Next

End Sub

---