如何在VBA中的一个文件中运行2个模块?

时间:2014-02-20 09:29:46

标签: excel vba excel-vba

我在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不再返回任何结果。

也许有人可以帮助理解这个问题的原因?

1 个答案:

答案 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