Question

我最近在我的项目中进行了一些数据分析。在我的情况下，我需要运行一个VBA，它可以自动从1-80中以升序排列的已关闭的excel工作簿列表中读取数据，其中我想要读取的数据存储在单元格F7中。

我尝试在互联网上研究线程，然后我想出了以下＆＃34;功能＆＃34;。它实际上有效，但它不会按升序循环。（1,2,3 ..... 9,10,11 ....... 80）excel是否将我的文件名视为字符串而不是数值？如果是，如何解决排序问题？

Private Sub test()
Dim fso As Object, FolDir As Object, FileNm As Object, Cnt As Integer
On Error GoTo erfix
Set fso = CreateObject("scripting.filesystemobject")
Set FolDir = fso.GetFolder("D:\Data\FYP")
Application.ScreenUpdating = False
For Each FileNm In FolDir.Files
If FileNm.Name Like "*" & ".xls" & "*" Then
Application.DisplayAlerts = False
UpdateLinks = True
Workbooks.Open Filename:=FileNm
Application.DisplayAlerts = True
Cnt = Cnt + 1

ThisWorkbook.Sheets("Sheet1").Range("A" & Cnt).Value = _
      Workbooks(FileNm.Name).Sheets("Sheet1").Range("F" & 7)

Workbooks(FileNm.Name).Close SaveChanges:=False
End If
Next FileNm
Application.ScreenUpdating = True
Set FolDir = Nothing
Set fso = Nothing
Exit Sub
erfix:
On Error GoTo 0
MsgBox "Error"
Application.ScreenUpdating = True
Set FolDir = Nothing
Set fso = Nothing
End Sub

谢谢

Answer 1

我从here获取了代码并对其进行了调整

Option Explicit

    Function kc_fsoFiles(theFolder, pattern) As Object

    Dim rsFSO, objFSO, objFolder, File
    Const adInteger = 3
    Const adVarChar = 200

        'create an ADODB.Recordset and call it rsFSO
        Set rsFSO = CreateObject("ADODB.Recordset")

        'Open the FSO object
        Set objFSO = CreateObject("Scripting.FileSystemObject")

        'go get the folder to output it's contents
        Set objFolder = objFSO.GetFolder(theFolder)

        'create the various rows of the recordset
        With rsFSO.Fields
            .append "Name", adVarChar, 200
            ' Field for the "number" part of the file name
            .append "DecName", adInteger
        End With
        rsFSO.Open

        'Now let's find all the files in the folder
        For Each File In objFolder.Files

            'hide any file that begins with the character to exclude
            If File.Name Like pattern Then
                rsFSO.AddNew
                rsFSO("Name") = File.Name
                ' if the basename is not an integer this will pobably crahs
                rsFSO("DecName") = objFSO.getbasename(File.Name)
                rsFSO.Update
            End If

        Next

        'Now get rid of the objFSO since we're done with it.
        Set objFSO = Nothing

        'And finally, let's declare how we want the files
        'sorted on the page. In this example, we are sorting
        'by DecName
        rsFSO.Sort = "DecName ASC "

        'Now get out of the objFolder since we're done with it.
        Set objFolder = Nothing

        'now make sure we are at the beginning of the recordset
        'not necessarily needed, but let's do it just to be sure.
        rsFSO.MoveFirst
        Set kc_fsoFiles = rsFSO

    End Function

如果您使用此功能，您将获得根据您的需求分类的文件名列表

Sub TestIt()
'Now let's call the function and open the recordset
'the folder we will be displaying
Dim strFolder:
strFolder = "...your folder here .."

'the actual recordset we will be creating with the kc_fsoFiles function
Dim rsFSO 'now let's call the function and open the recordset

Set rsFSO = kc_fsoFiles(strFolder, "*xlsx*")

'now we'll create a loop and start displaying the folder
'contents with our recordset. Of course, this is just a
'simple example and not very well formatted, i.e., not in
'a table, but it gets the point across on how you can
'ouput the recordset
  While Not rsFSO.EOF
    Debug.Print rsFSO.Fields("Name").Value
     rsFSO.MoveNext
   Wend

  'finally, close out the recordset
  rsFSO.Close
  Set rsFSO = Nothing
End Sub

从已关闭工作簿列表中读取数据的功能（动态）

1 个答案: