我在VBA中执行一个报告,允许将文件夹目录插入单元格“C7”。 然后Moduole1将返回文件夹(“C7”)中所有文件的超链接,所有文件名,文件维度和最后修改日期。 Module1脚本是:
Dim iRow
Sub IndiceFile()
If Range("C7").Value = "" Then
MsgBox "Insert the path into C7"
Range("B11:E1048576").Select
Selection.ClearContents
Range("C7").Select
Else
Range("B11:E1048576").Select
Selection.ClearContents
iRow = 11
Call ListMyFiles(Range("C7"), Range("C8"))
MsgBox "Path is detected"
End If
End Sub
Sub ListMyFiles(mySourcePath, IncludeSubfolders)
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
On Error Resume Next
For Each myFile In mySource.Files
iCol = 2
Cells(iRow, iCol).Value = myFile.Path
Cells(iRow, iCol).Select
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Name
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Size
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.DateLastModified
iRow = iRow + 1
Next
If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.Path, True)
Next
End If
Range("B11:B1048576").Select
Dim Cell As Range
For Each Cell In Intersect(Selection, ActiveSheet.UsedRange)
If Cell <> "" Then
ActiveSheet.Hyperlinks.Add Cell, Cell.Value
Range("C10").Select
End If
Next
End Sub
第二个模块会在报告中添加另一列,每个文件中包含行数。
Option Explicit
Sub CountRows()
Dim wbSource As Workbook, wbDest As Workbook
Dim wsSource As Worksheet, wsDest As Worksheet
Dim strFolder As String, strFile As String
Dim lngNextRow As Long, lngRowCount As Long
Application.ScreenUpdating = False
' Open a current workbook with one worksheet to list the results
Set wbDest = ActiveWorkbook
Set wsDest = wbDest.ActiveSheet
' Set the location of the folder for the source files
strFolder = Range("C7").Value
' Call the first file from the folder
strFile = Dir(strFolder & "*.*")
' Loop through each file in the folder
' Return the count of rows for each file in the destination file
lngNextRow = 11
Do While Len(strFile) > 0
Set wbSource = Workbooks.Open(Filename:=strFolder & strFile)
Set wsSource = wbSource.Worksheets(1)
lngRowCount = wsSource.UsedRange.Rows.Count
' wsDest.Cells(lngNextRow, "A").Value = strFile
wsDest.Cells(lngNextRow, "F").Value = lngRowCount
wbSource.Close savechanges:=False
lngNextRow = lngNextRow + 1
' Call the next file from the folder
strFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
目标是创建一个Module3,它将首先运行Module1然后运行Module2。 问题是单独(在2个不同的文件中)两个模块都有效。但是当我尝试吃Module1然后Module2(甚至手动)时,Module2不再返回任何结果。
也许有人可以帮助理解这个问题的原因?
答案 0 :(得分:0)
试试这段代码:
Option Explicit
Sub CountRows()
Dim wbSource As Workbook, wbDest As Workbook
Dim wsSource As Worksheet, wsDest As Worksheet
Dim strFolder As String, strFile As String
Dim lngNextRow As Long, lngRowCount As Long
Dim MyObject As Scripting.FileSystemObject
Set MyObject = New Scripting.FileSystemObject
Dim mySource As Folder
Dim myFile As Scripting.File
Dim i As Integer
Dim strPath As String
Application.ScreenUpdating = False
' Open a current workbook with one worksheet to list the results
Set wbDest = ActiveWorkbook
Set wsDest = wbDest.ActiveSheet
' Set the location of the folder for the source files
strFolder = Range("C7").Value
' Call the first file from the folder
Set mySource = MyObject.GetFolder(strFolder)
' Loop through each file in the folder
' Return the count of rows for each file in the destination file
lngNextRow = 11
For Each myFile In mySource.Files
strPath = myFile.Path
Set wbSource = Workbooks.Open(strPath)
Set wsSource = wbSource.Worksheets(1)
lngRowCount = wsSource.UsedRange.Rows.Count
' wsDest.Cells(lngNextRow, "A").Value = strFile
wsDest.Cells(lngNextRow, "F").Value = lngRowCount
wbSource.Close savechanges:=False
lngNextRow = lngNextRow + 1
' Call the next file from the folder
Next
Application.ScreenUpdating = True
End Sub