Sub chooseDocumentPath()
'Auther 云浮清秋
'弹框选择文件路径
'----------------------------------------------
    Dim dataExcel, Workbook, dataSheet, filePath
    Dim totalRow  As Integer
  
    Set dataExcel = CreateObject("Excel.Application")

    filePath = Application.GetOpenFilename(Title:="弹框显示的标题文本内容", MultiSelect:=False) '可以选择各种格式的文件

    '  filePath = Application.GetOpenFilename("Excel Files (*.xls*), *.Excel")     '必须选择excel格式的文件



    If   filePath <> False Then 
        Set Workbook = dataExcel.Workbooks.Open(filePath)

        Set dataSheet = Workbook.Worksheets(1)

On Error GoTo noData

        totalRow = dataSheet.UsedRange.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
        For i = 2 To totalRow
              Sheets("sheet1").Cells(i, 1) = dataSheet.Cells(i, 1)
              Sheets("sheet1").Cells(i, 2) = dataSheet.Cells(i, 2)
         Next i
       Workbook.Close
          MsgBox "读取成功！", vbSystemModal '读取完后弹框提醒
      Else
         Exit Sub

      End If

noData:
    MsgBox "你选择的文件无数据，请确认后再试！", vbSystemModal '读取不到数据

 
'----------------------------------------------
End Sub

 

'MOD2
Option Explicit
Private Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pDisplayName As String
    lpTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
                          "SHGetPathFromIDListA" (ByVal pidl As Long, _
                          ByVal pPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
                          "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
                          As Long
Private Const BIF_RETURNONLYFSDIRS = &H1
' *******************************************************************
' 函数名: BrowseFolder
' 功能: 浏览及选择文件夹通用对话框
' 使用方法:（1）将mdlBrowseFolder.bas模块添加到当前工程中;
' (2）在当前工程中使用
' dim strMyPath as String
' strMyPath=BrowseFolder("请选择目录")
' 代码段进行调用，用户选择的目录将保存在strPath字符串变量下;
' (3) 如果用户选择"取消"按钮,则strPath的值为空;
' *******************************************************************
Public Function BrowseFolder(strDialogTitle As String) As String
    Dim X As Long
    Dim bi As BROWSEINFO
    Dim dwIList As Long
    Dim strPath As String
    Dim wPos As Integer
    With bi
        .hOwner = 0& 'hWndAccessApp
        .lpTitle = strDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    dwIList = SHBrowseForFolder(bi)
    strPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal strPath)
    If X Then
        wPos = InStr(strPath, Chr$(0))
        BrowseFolder = Left$(strPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
    ' 确保返回的路径字符串的最后一个字符为"\"
    If BrowseFolder <> "" And Right$(Trim$(BrowseFolder), 1) <> "\" Then
        BrowseFolder = BrowseFolder & "\"
    End If
End Function

 
' 测试示例  

Sub Main()
    Dim strMyPath As String
    strMyPath = BrowseFolder("请选择目录")
    MsgBox "你选择的路径是: " & strMyPath
End Sub

摘自：网络整理

相关文章参考：


★VB查找替代字符串的函数 
★VB换行气泡提示类 
★VB/VBA通用路径选择对话框 
★ASCII码表0-255完整版 附详细注释 
★VB的KeyAscii
★VB取得TextBox、RichTextBox光标所在的行和列（支持汉字） 
★VB取得TextBox、RichTextBox光标所在的行和列（支持汉字）
★VB如何实现Undo(撤消)功能 
★VB计算文本文件的行数 
★VB获取快捷方式原文件路径 
★微软 Small Basic 简体中文版 已经发布了
★VB操作Excel 非常详细 [网摘] 
★VB如何判断文件正被占用/已被打开 
★VB添加listbox 的水平卷动轴
★VB打开资源管理器并指定文件
★VB根据窗体自动调整窗体内控件大小 注：实用，可以直接引用 
★VB中的指针技术 
★Visual Basic编程常见问题及解答（1） 
★Visual Basic编程常见问题及解答（2） 
★Visual Basic编程常见问题及解答（3） 
★VisualBasic变量、常数和数据类型及过程概述 
★VB6的后期绑定和前期绑定
★VB用户控件制作讲解与实例
★VB制作OCX控件的步骤 
★VB中FSO的调用的两种方法 
★用VB操作EXCEL 
★VB判断文件及目录的存在性 
★VB网站（最新、经典源代码、技术文章、基础知识） 
★VB得到指定文件夹下的文件列表 
★用VB产生随机任意大小文件挤满硬盘 
★VB文件的读写操作 
★VB创建超链接 打开指定网站的几种方法 
★VB 源码 删除重复行程序 函数 
★VB 计算自己程序段所用时间
★VB 获取路径名各部分 （获取文件路径，获取文件名，获取文件扩展名）自编 
★几行VB代码拿下注册表 
★VB 在浏览器中打开指定网址 
★VB窗口置顶 
★vb在 ListBox 之中点击右键弹出菜单 




更多精彩>>>

    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ActiveSheet.TextBox1.Value
        .Title = "请选择目录"
        If .Show Then
            ActiveSheet.TextBox1.Value = .SelectedItems(1) & "\"
        End If
    End With

Private Declare Function ShellExecute Lib 'shell32.dll' Alias 'ShellExecuteA' (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function FindWindow Lib 'user32' Alias 'FindWindowA' (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib 'user32' Alias 'PostMessageA' (ByVal hWnd As Long, ByVal wMsg As Long, ByVal sParam As Long, ByVal lParam As Long) As Long
Private Const WM_CLOSE As Long = &H10
'以上代码声明API函数和常量
Public Sub OpenDirectory()
Dim path1 As String
path1 = ActiveCell
ShellExecute 0, '', '', '', path1, 1
End Sub
Public Sub CloseDirectory()
Dim hWnd As Long
hWnd = FindWindows(vbNullString, 'C:\Program Files\Microsoft Office\Office12')
PostMessage hWnd, WM_CLOSE, 0, 0
End Sub