vba 按顺序打开文件夹下含特定字符的工作簿

Posted 2023-05-09

据说workbooks.open不能用通配符。
文件夹里都是月报表，但不一定每月都有。
我知道：
1、文件的路径，Z:\2006\
2、文件的大致名称：是严格按年月日来命名的，格式是2006-08-**.xls 或者2006-08-**.xlsx
3、每个月最多只有一个文件，也就是只有一个2006-08-**.xls(或者2006-08-**.xlsx)
4、字符串，整形变量和循环（for i=1 to X next i）操作的基本规则
问题是：怎么用按顺序打开它们？中间不报错
http://pan.baidu.com/s/1hqu5C4c

如果能确保文件夹下类似2006-08-**.xls 或者2006-08-**.xlsx的文件只有一个，可用把如下代码

Sub xx()
Dim yy, mm, pth, fn, i
yy = [f3]
pth = "D:\\" & yy & "\\"
For i = [f4] To 12
    fn = Dir(pth & yy & "-" & Format(i, "00") & "-*.*")
    If fn <> "" Then
        Application.Workbooks.Open pth & fn
        \'在此添加操作代码
        Application.Workbooks(fn).Close True \'如要手动关闭文件删除本行
    End If
Next
End Sub 参考技术A Sub OpenAllExcel()
    Dim fPath As String, fName As String
    
    fPath = "Z:\\2006\\"
    fName = Dir(fPath & "*.xls")
    Do While fName <> ""
        Application.Workbooks.Open fPath & fName
        '这里可以添加对每个打开文件的操作。
        fName = Dir
    Loop
End Sub

正常来说，如果你的文件名那么有规律，程序给出的就是按照日期排序的文件，不用特意再排序了。

如果有特殊情况，可以再使用排序。排序后再依次打开文件。

参考技术B 把文件名放到字典里，变成数组后，就可以用like比较了吧追问

那请给我2000到2014每月最后一天的辞典，并告诉怎么用好吗？很初级的读码能力。谢谢！

追答

你的文件我没太看懂啊。

VBA编程14.操作工作簿对象

【访问工作簿】

对已经打开的工作簿，可以通过使用索引号来访问工作簿，也可以通过名称来访问工作簿

【代码区域】

Sub 访问工作簿()
    Dim counter As Integer
    counter = Workbooks.Count
    Debug.Print
    Debug.Print "当前打开工作簿的数目为：" & CStr(counter)
    Debug.Print "按索引号访问工作簿如下："
    Debug.Print "第一个工作簿是：" & Workbooks(1).name
    Debug.Print "第一个工作簿是：" & Workbooks(2).name
    Debug.Print "按名称访问工作簿如下："
    Debug.Print "第一个工作簿是：" & Workbooks("VBA.xlsm").name
    Debug.Print "第一个工作簿是：" & Workbooks("TEST.xlsx").name
End Sub

【打印结果】

现在打开的工作簿为：

【获取工作簿信息】

【代码区域】

Sub 获取工作簿信息()
    Dim wb As Workbook
    Set wk = Workbooks(1)
    wk.Activate
    Debug.Print
    Debug.Print "当前Excle文档的信息如下："
    Debug.Print "工作簿的名称为：" & wk.name
    Debug.Print "工作簿的保存位置为：" & wk.Path
    Debug.Print "工作簿是否只读：" & CStr(wk.ReadOnly)
    Debug.Print "工作簿的全名为：" & wk.FullName
    Debug.Print "工作簿是否需要密码：" & wk.HasPassword
End Sub

【结果展示】

【新建工作簿】

【代码区域】

Sub 新建工作簿()
    Dim wb As Workbook
    Dim wk As Worksheet
    Rem 设置初始化工作簿中默认的工作表数目
    Application.SheetsInNewWorkbook = 2
    Set wb = Workbooks.Add \'新建工作簿
    Set ws = wb.Sheets(1)
    ws.name = "产品"
    Set ws = wb.Sheets(2)
    ws.name = "原料"
    Rem 恢复初始工作簿中默认的工作表
    Application.SheetsInNewWorkbook = 3
    MsgBox "成功完成了新建工作簿！", vbOKOnly, "新建工作簿"
    Set wb = Nothing
    Set ws = Nothing
End Sub

【结果展示】

                                                                                                 

【使用对话框打开工作簿】

【代码区域】

Sub 使用对话框打开工作簿()
    Dim fileInformation As String
    fileInformation = Application.GetOpenFilename("Excle 工作簿(*.xlsx),*.xlsx")
End Sub

【结果展示】

 

【备份工作簿】

【代码区域】

Sub 备份工作簿()
    Dim wk As Workbook
    Dim mypath As String
    Dim myfile As String
    Dim filefull As String
    Set wk = Workbooks(1)
    wk.Activate
    mypath = wk.Path
    myfile = "备份" + wk.name
    filefull = mypath + "\\" + myfile
    wk.SaveCopyAs filefull
    \'vbLf 换行
    MsgBox "备份成功！" & vbLf & "备份文件于" & mypath & "\\" & & myfile & vbLf & "备份文件的全名为：" & filefull, vbOKOnly, "备份工作簿"
    Set wk = Nothing
End Sub

【效果展示】

                                                        

                                                   

【使用保存对话框保存工作簿】

【代码区域】

Sub 使用保存对话框来保存文件()
    Dim wk As Workbook
    Dim fileinfo As String
    Set wk = Workbooks(1)
    wk.Activate
    fileinfo = Application.GetSaveAsFilename(exclefile, "Excle 工作簿(*.xlsm),*.xlsx")
    If fileinfo = "False" Then
    MsgBox "请输入工作簿名字", vbOKOnly, "保存工作簿"
    Exit Sub
    End If
    wk.SaveAs Filename:=fileinfo
    Set wk = Nothing
End Sub

【效果展示】

【设置工作簿窗口大小】

【代码区域】

 

Sub 设置工作簿窗口大小()
    Dim win As Window
    Dim windate As Long
    Dim winwidth As Long
    Dim winheight As Double
    Set win = Application.ActiveWindow
    win.Activate
    With win
        winstate = .WindowState
        winwidth = .Width
        winheight = .Height
        
        \'设置窗口状态
        .WindowState = xlNormal
        .Width = 600
        .Height = 300
        MsgBox "设置窗口大小之前：" & vbLf & "窗口状态为：" & CStr(winstate) & vbLf & "窗口宽度为：" & CStr(winwidth) & vbLf & "窗口高度为：" & CStr(winheight) & vbLf & "设置窗口大小之后：" & vbLf & "窗口状态为：" & CStr(.WindowState) & vbLf & "窗口宽度为：" & CStr(.Width) & vbLf & "窗口高度为：" & CStr(.Height)
    End With
End Sub

【效果展示】

 

【冻结窗口】

在Excle中可以直接使用冻结窗口冻结，但是这个不是很方便

下面我们使用宏来自定义冻结的行

【代码区域】

 

Sub 冻结窗口()
    Dim win As Window
    Set win = Application.ActiveWindow
    With win
        .Split = True \'冻结开关打开
        .SplitColumn = 4 \'从第4列开始冻结
        .SplitRow = 3    \'从第3行开始冻结
    End With
     win.FreezePanes = True \'拆分冻结项打开
     MsgBox "冻结完成！", vbOKOnly, "冻结窗口"
     Set win = Nothing
End Sub

 

【效果展示】

【更改工作簿名称】

【代码区域】

Sub 更改工作簿名称()
    Dim filename As String
    filename = "C:\\OLIVER.xlsx"
    Name filename As "C:\\OLIVER_附件.xlsx"
    MsgBox ("工作簿名称修改完成"), vbOKOnly, "修改名称"
End Sub

【效果展示】

【关闭工作簿】

【代码区域】

 Application.ActiveWorkbook.Close
 Application.Quit