防止工作簿存储在VBA Project Explorer中

时间:2018-07-25 21:21:31

标签: vba excel-vba project-explorer

我拥有的代码循环通过一个包含100多个文件(每天添加更多文件)的文件夹,并复制文件,数据等。我循环通过的每个文件最终都在VBA Project Explorer中,如您所见图片。这确实减慢了我的代码的运行时间。 有什么方法可以防止将每个工作簿添加到Project Explorer吗?另外,我还没有使用我调用的optimize子例程来运行我的代码,因为我是在运行原始代码后添加了这些子例程的(现在,编辑器基本上已冻结)。我附加了我的代码以及下面的问题图片!

Overloaded VBA Project Explorer

Sub TransferSAPCLData_Click()

'Code Optimization
Call OptimizeCode_Begin

'Declaring and Setting Variables
Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject

Dim MyDir As String
Dim fil As Scripting.file
Dim FolderSource As Scripting.Folder
Dim FolderPathDest As String, wbDest As Workbook, wsDest As Worksheet
Dim wbSource As Workbook, wsSource As Worksheet
Dim lrDest As Long, fileDest As String, lrSource As Long
Dim CurrentFile As String
Dim fileSource As String

MyDir = "C:\Users\quirk\Desktop\Cory Project\Wave 1A Content\SAPCL Spreadsheets\SAPCL Raw Data Files"

'Defining destination characteristics
FolderPathDest = "C:\Users\quirk\Desktop\Cory Project\Wave 1A Content\Master SAPCL Folder"
fileDest = "C:\Users\quirk\Desktop\Cory Project\Wave 1A Content\Master SAPCL Folder\Function Master File.xlsm"
'Workbooks.Open Filename:=fileDest
Set wbDest = ActiveWorkbook ' Workbooks("MASTER.xlsx")
Set wsDest = wbDest.Worksheets("Sheet1")


'Looping through files
Set FolderSource = fso.GetFolder(MyDir)
For Each fil In FolderSource.Files
    Debug.Print fil.Name
    CurrentFile = fil.Name
    If Not fso.FileExists(FolderPathDest & "\" & fil.Name) Then
        fso.CopyFile _
        Source:=MyDir & "\" & fil.Name _
        , Destination:=FolderPathDest & "\" & fil.Name
            fileSource = MyDir & "\" & fil.Name
            Workbooks.Open Filename:=fileSource '
            ActiveWindow.Visible = False
            Set wbSource = Workbooks(CurrentFile)
            Set wsSource = wbSource.Worksheets(1)
                lrSource = wsSource.Range("A" & wsSource.Rows.Count).End(xlUp).Row
                lrDest = wsDest.Range("A" & wsDest.Rows.Count).End(xlUp).Row + 1
                wsSource.Range("A2:V" & lrSource).Copy Destination:=wsDest.Range("A" & lrDest)
    End If
Next fil

'Optimize Code
Call OptimizeCode_End

End Sub

0 个答案:

没有答案