题目一

用窗口选择/打开文件

Sub get方法()

    Dim fname
    
    fname = Application.GetOpenFilename()
    '获取选择的文件名
    If fname <> False Then
    '判断是否有选中，如果点了取消，则退出程序
    '否则运行文件
        MsgBox fname
        '返回字符串
        Workbooks.Open fname
        '这个过程才是打开
    End If
    
End Sub

有不少可选参数可以设置

Sub get方法()

    Dim fname
    
    fname = Application.GetOpenFilename( _
    filefilter:="EXCEL文件,*.xlsx;*.xlsm,全部,*", _
    FilterIndex:=1, _
    Title:="请选择一个文件", _
    MultiSelect:=True)
    '过滤器选择EXCEL文件或者全部文件
    '默认选择的是第一个，EXCEL文件
    '对话框的标题是"请选择一个文件"
    '支持多选
    If IsArray(fname) Then
    '判断是否有选中，选中一个也是数组
        For Each s In fname
            MsgBox s
            Workbooks.Open s
            '这个过程才是打开
        Next s
    End If
    
End Sub

在这里插入图片描述
按住shift实现多选

同理，还可以用于保存

Sub save方法()

    Dim fname, w As Workbook
    
    Set w = ActiveWorkbook
    
    fname = Application.GetSaveAsFilename( _
        filefilter:="EXCEL文件,*.xlsx;*.xlsm,全部,*", _
        FilterIndex:=1, _
        Title:="请保存到硬盘", _
        InitialFileName:="报表test.xlsm")
    '过滤器选择EXCEL文件或者全部文件
    '默认选择的是第一个，EXCEL文件
    '对话框的标题是"请选择一个文件"
    '默认保存名
    If fname <> False Then
    '判断是否有选中
        MsgBox s
        w.SaveAs fname
        '这个过程才是保存
    End If
    
End Sub

题目二

application.filedialog

msoFileDialogOpen	文件打开对话框	可以直接执行
msoFileDialogSaveAs	文件保存对话框	可以直接执行
msoFileDialogFilePicker	文件浏览对话框	不能直接执行
msoFileDialogFolderPicker	文件夹浏览对话框	不能直接执行

直接打开文件
Excel中只能打开Excel文件，不能打开其他的

Sub filedialog方法2()
    
    Dim fd As FileDialog, i As Long
    
    Set fd = Application.FileDialog(msoFileDialogOpen)
    
    If fd.Show = -1 Then
        fd.Execute
        'open所选的文件
    End If
    
End Sub

只读取名字

Sub filedialog方法()
    
    Dim fd As FileDialog, i As Long
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    fd.Title = "打开文件"
    '设置名称
    fd.InitialFileName = "G:\网课\杨洋VBA\" _
     & "全民一起VBA实战篇(Excel数据分析)" _
     & "\专题四：外部文件处理技巧\"
    '指定初始目录
    fd.AllowMultiSelect = True
    '设置可以多选
    fd.Filters.Clear
    '清除已有的默认 格式
    fd.Filters.Add "EXCEL文件", "*.xlsm;*.xlsm"
    fd.Filters.Add "文本文件", "*.txt"
    '添加名字，格式
    fd.FilterIndex = 1
    '默认用第一个格式
    If fd.Show = -1 Then
        For i = 1 To fd.SelectedItems.Count
            MsgBox fd.SelectedItems(i)
            '括号里的数字用于确定用户选中的第i个文件
        Next i
    End If
    
End Sub

其余几个用法类似，只是选中文件夹不能多选

题目三

文件夹有以下几个文件

在这里插入图片描述

他们分别对应不同的部门，下面需要将他们放在对应部门所在的文件夹下，如果没有该文件夹，新建一个

Option Explicit
Sub 分类放入()
    Dim i As Long, fname As String, dptpath As String
    Dim rootpath
    rootpath = "G:\网课\杨洋VBA\全民一起VBA实战篇(Excel数据分析)\专题四：外部文件处理技巧\"
    For i = 2 To ActiveSheet.UsedRange.Rows.Count
        fname = Cells(i, 1) & ".txt"
        '设置文件名
        dptpath = rootpath & Cells(i, 2) & "\"
        '设置文件夹名
        If Dir(rootpath & fname) <> "" Then
        '如果对应文件在根目录下存在
            If Dir(dptpath, vbDirectory) = "" Then
            '如果对应文件夹不存在
                MkDir (dptpath)
                '新建对应文件夹
            End If
            
            FileCopy rootpath & fname, dptpath & fname
            '拷贝，前一个是源文件，后一个是目标文件，都要写完整路径名，
            '且目标文件名可以和源文件名称不同
            Kill rootpath & fname
             '删除源文件
        End If
    Next i
    
End Sub

可得到
在这里插入图片描述
如果需要把文件从里面取出，同时删除掉空文件夹

Sub 从子文件夹剪切出()
Dim i As Long, fname As String, dptpath As String
    Dim rootpath
    rootpath = "G:\网课\杨洋VBA\全民一起VBA实战篇(Excel数据分析)\专题四：外部文件处理技巧\"
    For i = 2 To ActiveSheet.UsedRange.Rows.Count
        fname = Cells(i, 1) & ".txt"
        dptpath = rootpath & Cells(i, 2) & "\"
        '设置文件夹名
        If Dir(dptpath, vbDirectory) <> "" Then
        '如果文件夹存在
            If Dir(dptpath & fname) <> "" Then
                '如果文件夹下该文件存在
                FileCopy dptpath & fname, rootpath & fname
                '拷贝，前一个是源文件，后一个是目标文件，都要写完整路径名，
                '且目标文件名可以和源文件名称不同
                Kill dptpath & fname
                 '删除源文件
            End If
        End If
    Next i
    
    For i = 2 To ActiveSheet.UsedRange.Rows.Count
    dptpath = rootpath & Cells(i, 2) & "\"
        If Dir(dptpath, vbDirectory) <> "" Then
            '如果文件夹存在
            RmDir dptpath
            '删除该文件夹
        End If
    Next i
End Sub

题目四

.通过DIR可以得到一个文件下所有的文件，但是不能分离出哪些是文件，哪些是文件夹
可以通过AND的位运算来区别

.(一个点)	代表所在文件夹本身
…(两个点)	代表所在文件夹的上级文件夹

在这里插入图片描述

Sub dirdemo()

    Dim fname As String, i As Long
    i = 1
    Dim path
    path = "G:\网课\杨洋VBA\全民一起VBA实战篇(Excel数据分析)\专题四：外部文件处理技巧\"
    fname = Dir(path, vbDirectory)
    
    Do While fname <> ""
        
 
        x = GetAttr(path & fname)
        Cells(i, 1) = fname
        If (x And vbDirectory) = vbDirectory Then
        '位运算
            
            Cells(i, 2) = "文件夹"
        End If
        
        i = i + 1
        
        fname = Dir
    Loop
    
End Sub

在这里插入图片描述
文件的一些属性，通过GetAttr来获得属性值，再做AND运算，如果和某一位同，那么AND之后结果为1，否则为0

题目五

为了找到子文件夹下的子文件夹下的子文件夹，必须学会递归的手法，下面通过递归了计算阶乘

Sub 递归demo()
    
    Cells(1, 1) = 阶乘(5)
    
End Sub

Function 阶乘(n As Long)

    Dim s
    
    If n = 1 Then
        s = 1
    Else
        s = n * 阶乘(n - 1)
    End If
    
    阶乘 = s
    
End Function

题目六

遍历某个文件夹下所有文件和文件夹

Option Explicit
Dim i As Long

Sub demo()
    Dim t
    t = Timer()
    i = 1
    list "E:\"
    '初始根目录
    Cells(2, 3) = "一共用时" & Timer() - t & "秒"
End Sub

Function list(folder)
    Dim fname, subfolders As Collection
    '字文件名，子目录
    Set subfolders = New Collection
    '子目录作为一个集合
    'collection相当于没有value只有key的字典
    fname = Dir(folder, vbDirectory)
    '扫描根目录下的文件
    Do While fname <> ""
        If fname <> "." And fname <> ".." Then
        '排除掉.和..的干扰
            If (GetAttr(folder & fname) And vbDirectory) <> vbDirectory Then
            '如果是文件而不是文件夹
                Cells(i, 1) = folder & fname
                
                i = i + 1
            Else
            '是文件夹
                subfolders.Add folder & fname & "\"
                '作为新的根目录放入collection里面
            End If
        End If
        fname = Dir
        '扫描文件
    Loop
    
    For Each fname In subfolders
        list fname
    Next fname
    '最后放到集合里面再去遍历
    '因为如果直接在do while循环里面遍历
    'dir遍历到最后肯定为空，但是进入下一个循环前
    'dir传参给fname，fname为空，就会报错
    '所以直接只管记录
End Function

如果只需要所有文件夹的名字，那么将下面的代码稍作修改

If (GetAttr(folder & fname) And vbDirectory) <> vbDirectory Then
            '如果是文件而不是文件夹
                Cells(i, 1) = folder & fname
                
                i = i + 1
            Else
            '是文件夹
                subfolders.Add folder & fname & "\"
                '作为新的根目录放入collection里面
            End If

改为

 If (GetAttr(folder & fname) And vbDirectory) = vbDirectory Then
            '如果是文件夹
                Cells(i, 1) = folder & fname
                i = i + 1
                subfolders.Add folder & fname & "\"
                '作为新的根目录放入collection里面
            End If