Question

我将这些代码拼接在一起。它从工作簿中获取工作表，将它们作为单独的工作簿保存在新文件夹中，然后通过电子邮件将其发送给PM以进行操作。我盲目地写了它，不知道工作簿是如何构建的。然后我找到了工作簿（它是一个受限制的访问文件），有前4个工作表我需要忽略。我添加了另一个if循环来忽略包含字符串＆＃34; IGNORE＆＃34;的工作表。在单元格A2中。它在我添加这个if语句之前工作得如此之快，现在似乎需要更长的时间。我担心在我要实现它的工作簿上（20个工作表）会不合理地放慢速度。我想在调试模式下进行观察，我想，但任何帮助都将非常感激。这是代码：

Sub SplitWorkbook()
'TMP June 5, 2018 Export and save worksheets as new Workbook in a new folder
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim FolderName As String
'TMP June 5, 2018 added following dims for auto email generator submodule
Dim oApp As Object
Dim oMail As Object
Dim eAdd As Object
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook
DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
FolderName = xWb.Path & "\" & xWb.Name & " " & DateString
MkDir FolderName
For Each xWs In xWb.Worksheets
      xWs.Copy
    If Val(Application.Version) < 12 Then
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        Select Case xWb.FileFormat
            Case 51:
                FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If Application.ActiveWorkbook.HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56:
                FileExtStr = ".xls": FileFormatNum = 56
            Case Else:
                FileExtStr = ".xlsb": FileFormatNum = 50
        End Select
    End If
  Set eAdd = ActiveSheet.Range("A2")
  If eAdd <> "IGNORE" Then
  xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
    Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
        'TMP June 5,2018 Added submodule to create and show the Outlook mail item
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
    Set eAdd = ActiveSheet.Range("A1")
    With oMail
        'selects the to from A1
        .to = ActiveSheet.Range("A1")
        'Sets the subject
        .Subject = "Your hammer sheet is attached"
        'Creates the body of the email
        .body = ActiveSheet.Range("A2") & vbNewLine & vbNewLine & _
          "Here is your hammer sheet to fill out and send back within 2 days" & vbNewLine & vbNewLine & "Thanks a lot," & vbNewLine & vbNewLine & "Mounir Samara"
        .Attachments.Add xFile
        .Display
    End With
    Application.ActiveWorkbook.Close False
 End If ''IGNORE' if loop
Next
MsgBox "You can find the files in " & FolderName
Application.ScreenUpdating = True
End Sub

添加的代码会显着减慢处理时间

0 个答案: