注册 登录
编程论坛 Excel/VBA论坛

求助,代码错误400,什么原因? 引用多个文件夹固定单元格数据

successmyc 发布于 2022-04-25 11:21, 1361 次点击

请教,汇总多个文件夹固定单元格数据,引用高手的代码如下,提示错误400,请教各位高手帮帮忙。
Sub 汇总数据()
        Dim arr, brr, i&, m&, k%, bookName$, wb As Workbook
        k = CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files.Count
        ReDim brr(1 To k, 1 To 8)
        m = 1
        arr = Array("文件名称", "销售单号", "打印日期", "合约编号", "项目名称", "单位", "金额", "经办人")
        For i = 0 To UBound(arr)
            brr(m, i + 1) = arr(i)
        Next
        Application.ScreenUpdating = False
        Dim mPath As String: mPath = ThisWorkbook.Path & "\"
        Dim mFile As String: mFile = Dir(mPath & "*.xls")
        Do
                If mFile <> ThisWorkbook.Name Then
                        Set wb = GetObject(mPath & mFile)
                        With wb
                                arr = .Worksheets(1).Range("Al").CurrentRegion.Value
                                bookName = Split(.Name, ".")(0)
                                .Close False
                        End With
                        m = m + 1
                        brr(m, 1) = bookName
                        brr(m, 2) = mTrim(arr(2, 11))
                        brr(m, 3) = arr(3, 11)
                        brr(m, 4) = arr(4, 11)
                        brr(m, 5) = arr(2, 5)
                        brr(m, 6) = mTrim(arr(5, 3))
                        brr(m, 7) = arr(8, 9)
                        brr(m, 8) = arr(12, 10)
                End If
                mFile = Dir
        Loop While mFile <> Empty
        If m = 1 Then Exit Sub
        With ActiveSheet
        .Cells.Clear
        .Range("Al").Resize(m, 8).Value = brr
        With .UsedRange
                .Borders.LineStyle = 1
                .Rows.AutoFit
                .Columns.AutoFit
        End With
        .Columns("B:H").HorizontalAlignment = xlCenter
        .Range("A1:H1").Interior.Colorlndex = 6
        End With
        Application.ScreenUpdating = True
        MsgBox "OK"
End Sub
Public Function mTrim(mStr) As String
        mStr = Application.Clean(mStr)
        mStr = VBA.Replace(mStr, Chr(0), Empty)
        mStr = VBA.Replace(mStr, Chr(10), Empty)
        mStr = VBA.Replace(mStr, Chr(13), Empty)
        mStr = VBA.Replace(mStr, Chr(32), Empty)
        mStr = VBA.Replace(mStr, Chr(127), Empty)
        mStr = VBA.Replace(mStr, "", Empty)
        mStr = VBA.Replace(mStr, "", Empty)
        mTrim = mStr
        End Function
只有本站会员才能查看附件,请 登录
0 回复
1