组合两个子例程而不重新选择文件

Question

我编写了两个子例程，这两个子例程当前都分配给主模板工作簿中的单独按钮。它们都可以正常工作而且一切都很好但是我希望能够将它们组合在一起，这样一个按钮就可以在一个按钮中执行整个例程。现在我知道一个简单的调用可以在这里工作，但那需要用户重新选择文件。

因此，第一个例程创建两个适当命名的文本文件，然后第二个例程删除创建原始文本文件时创建的所有空行（空白区域），但此时，用户需要重新选择新生成的文本文件要执行。

有没有一种好的，有效的方法来组合这些而不会失去功能？没有调用第二个例程？

     Option Explicit

     Public Sub OneRoutine()

     Dim strFile As String
     Dim MyNewBook As String
     Dim MySaveFile As String
     Dim fileToOpen As Variant
     Dim fileName As String
     Dim sheetName As String
     Dim rCopy As Range
     Dim lastrow As Integer
     Dim wb As Workbook


     'Turn off display alerts
     Application.DisplayAlerts = False
     'Turn off screen updates
     Application.ScreenUpdating = False

     'Ensures that the file open directory is always the same
     ChDir "S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\"

     'Opens the folder to location to select txt file
     fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
        If fileToOpen <> False Then
        Workbooks.OpenText fileName:=fileToOpen, _
        DataType:=xlDelimited, Tab:=True
        End If
     'Creates the file name based on txt file name
    fileName = Mid(fileToOpen, InStrRev(fileToOpen, "\") + 1)
    'Creates the sheet name based on the active txt file
    sheetName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)

    'Rename the original text file
    ActiveWorkbook.SaveAs ("S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\" 
     & "DNU_" & fileName)

    'Save active file as...
    ActiveWorkbook.SaveAs ("S:\MERIT OUTPUTS FOLDER\MSI Recruitment 
     Limited\BACS File Original\" & _
    fileName & ".CSV"), FileFormat:=xlCSV

    'Selects all data in column A and copies to clipboard
    Set rCopy = Range("A1", Range("A1").End(xlDown))

     'Open the original document where the BACS file is located
    Workbooks.Open "S:\Accounts (New)\Management Information (Analysis)\Phil 
     Hanmore - Analysis\bacs conversion calc.xlsx"
    'Selects the worksheet called "Original"
    Sheets("Original").Range("A:A").ClearContents

    'Paste selected values from previous sheet
    rCopy.Copy
    Sheets("Original").Range("A1").PasteSpecial Paste:=xlPasteValues

    'This checks cells T5 and U5 on the "Original" tab. If either are false 
     then the macro will stop, if both are true it will continue on normally
     If Range("T5").Value = "False" Then
       MsgBox "An error has occured!" & vbNewLine & "Please speak to Phil 
    Hanson before continuing", vbCritical
        Exit Sub
    End If

    If Range("U5").Value = "False" Then
       MsgBox "An error has occured!" & vbNewLine & "Please speak to Phil 
     Hanson before continuing", vbCritical
        Exit Sub
    End If

    'Saves the BACS Conversion Calculator
    ActiveWorkbook.SaveAs "S:\Accounts (New)\Management Information 
      (Analysis)\Phil Hanmore - Analysis\bacs conversion calc.xlsx"

     'Selects appropriate worksheet - Non-MyPayFINAL
     Sheets("Non-MyPay FINAL").Select

    'Selects all data in column A and copies to clipboard
    Range("A1", Range("A1").End(xlDown)).Select
    Selection.Copy

    'Add a new workbook
    Workbooks.Add
    'Paste selected values from previous sheet
    Selection.PasteSpecial Paste:=xlPasteValues


    'Build SaveAs file name (for CSV file)
    MySaveFile = Format(Now(), "DDMMYYYY") & "NonMyPayFINALTest" & ".CSV"
    'Save template file as...(for CSV file)
    ActiveWorkbook.SaveAs ("S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\" 
     & MySaveFile), FileFormat:=xlCSV

     'Build SaveAs file name (for Txt file)
    MySaveFile = Format(Now(), "DDMMYYYY") & "NonMyPayFINALTest" & ".Txt"
    strFile = "S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\" & MySaveFile
    ActiveWorkbook.SaveAs (strFile), FileFormat:=xlTextWindows
    'Save template file as...(for Txt file)
    'ActiveWorkbook.SaveAs ("S:\MERIT OUTPUTS FOLDER\MSI Recruitment 
    Limited\" & MySaveFile), FileFormat:=xlTextWindows

    'Close the new saved file
     ActiveWorkbook.Close

     Call AltText_V2



    'Selects appropriate worksheet - MyPayFINAL
    Sheets("MyPay FINAL").Select

    'Selects all data in column A and copies to clipboard
    Range("A1", Range("A1").End(xlDown)).Select
    Selection.Copy

    'Add a new workbook
    Workbooks.Add
    'Paste selected values from previous sheet
    Selection.PasteSpecial Paste:=xlPasteValues

    'Build SaveAs file name (for CSV file)
    MySaveFile = Format(Now(), "DDMMYYYY") & "MyPayFINALTest" & ".CSV"
    'Save template file as...(for CSV file)
    ActiveWorkbook.SaveAs ("S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\" 
     & MySaveFile), FileFormat:=xlCSV

    'Build SaveAs file name (for Txt file)
    MySaveFile = Format(Now(), "DDMMYYYY") & "MyPayFINALTest" & ".Txt"
    strFile = "S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\" & MySaveFile
    ActiveWorkbook.SaveAs (strFile), FileFormat:=xlTextWindows
    'Close the new saved file
    ActiveWorkbook.Close

    'Save template file as...(for Txt file)
    'ActiveWorkbook.SaveAs ("S:\MERIT OUTPUTS FOLDER\MSI Recruitment 
    Limited\" & MySaveFile), FileFormat:=xlTextWindows
    Call AltText_V2

    'Close original source workbook (template)
    Windows("bacs conversion calc.xlsx").Close
    'Close final workbook
    ActiveWorkbook.Close savechanges:=True
      'Deletes the original copy
     Kill fileToOpen
     'Displays message box
      MsgBox "Your file has been processed successfully!", vbExclamation

    'Calls the next subroutine
    'Call AltText_V2

   'Turn on display alerts
    Application.DisplayAlerts = True
    'Turn on screen updates
    Application.ScreenUpdating = True

     End Sub

     Sub AltText_V2()
      Dim inFile As String
      Dim outFile As String
      Dim data As String
      Dim strFile As String

     'Ensures that the file open directory is always the same
      ChDir "S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\"

     'inFile = Application.GetOpenFilename
     inFile = strFile
     Open inFile For Input As #1

     outFile = inFile & ".txt"
     Open outFile For Output As #2

      Do Until EOF(1)
      Line Input #1, data

      If Trim(data) <> "" Then
         Print #2, data
      End If
     Loop

     Close #1
     Close #2

     Kill inFile
     Name outFile As inFile

     MsgBox "File alteration completed!"
     End Sub

Answer 1

通常，两个例程是更好的方法，您只需将文件名从第一个例程传递到第二个例程即可。因此，它会工作，你不需要选择。如果它是一个例程，它会变得太长而且凌乱。尝试这样的事情：

'Option Explicit

Public Sub OneRoutine()
    Dim strFile As String

    '...rest of the code

    MySaveFile = Format(Now(), "DDMMYYYY") & "MyPayFINALTest" & ".Txt"
    strFile = "S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\" & MySaveFile
    ActiveWorkbook.SaveAs (strFile), FileFormat:=xlTextWindows

    Call AltText_V2(strFile)

    'Close the new saved file
    ActiveWorkbook.Close

    '...rest of the code

End Sub

Sub AltText_V2(strFile As String)

    Dim inFile As String
    Dim outFile As String
    Dim data As String

    'Ensures that the file open directory is always the same
    ChDir "S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\"

    inFile = strFile
    Open inFile For Input As #1

    '...rest of the code

End Sub

此外，第二个例程变得更加可重复和独立，因此通常代码是健壮的。

Answer 2

您可以将文件路径保存到全局变量，然后不要弹出选择文件。