合并两个子例程而不重新select文件
我写了两个子例程，这两个子例程当前都分配给主模板工作簿中的单独button。 他们都工作没有错误，一切都很好，但我希望能够结合他们，让一个button将执行在一个整个例程。 现在我知道一个简单的调用可以在这里工作，但是这就要求用户重新select文件。
因此，第一个例程创build两个适当命名的文本文件，然后第二个例程删除创build原始文本文件时创build的所有空白行（空白），但是此刻用户需要重新select新生成的文本文件来执行。
有没有一个好的，有效的方法来结合这些不失function？ 不要只是调用第二个例程？
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 一般来说，两个例程是一个更好的方法，你应该简单地把文件的名字从第一个例程传递到第二个例程。 因此，它会工作，你不需要select。 如果是一个例程，它会变得太长而且杂乱。 尝试这样的事情：
'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
此外，第二个例程变得更加可重用和独立，因此通常代码是健壮的。
您可以将filepath保存到全局variables，然后不涉及select文件的popup。