結合兩個子例程而不重新選擇文件

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

您可以將filepath保存到全局變量，然後不涉及彈出選擇文件。