覆盖初始文件名

Question

在地方提供了一些帮助之后，我写了下面的代码，它完美地工作，但我需要能够覆盖最初的文件名（我们被要求用GetOpenFilename选择的那个）来包含！DNU！所以用户在选择它之后就知道了，而不是再次选择相同的文件，特别是他们将使用的文件都非常相似。你可以看到我试着用'重命名原始文本文件'下面的行，但它什么也没做！任何帮助，将不胜感激。

Sub BACSConversion() 

Dim MyNewBook As String 
Dim MySaveFile As String 
Dim fileToOpen As Variant 
Dim fileName As String 
Dim sheetName As String 
Dim rCopy As Range 

'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" & sheetName & "!DNU!" & ".txt") 

'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 conversation 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 

'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") & "NonMyPayFINAL" & ".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") & "NonMyPayFINAL" & ".Txt" 
    '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 

'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") & "MyPayFINAL" & ".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") & "MyPayFINAL" & ".Txt" 
'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 
'Close original source workbook (template) 
    Workbooks("bacs conversation calc").Close 
'Close final workbook 
    ActiveWorkbook.Close savechanges:=True 

    MsgBox "Your file has been processed successfully!", vbExclamation 

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

    End Sub 

    Sub FileNameChange() 

    Dim oldPath As String 
    Dim newPath As String 

    oldPath = "S:\Accounts (New)\Management Information (Analysis)\Phil 
    Hanmore - Analysis\Neil Test\" & Test & ".xlsx" 
    newPath = "S:\Accounts (New)\Management Information (Analysis)\Phil 
    Hanmore - Analysis\Neil Test\" & Test & "!DNU!.xlsx" 



    End Sub 

Answer 1

存在VBA内置函数调用Name，其工作原理如下：

Name [old/current path/name] [new path/name] 

因此，对于你的代码，你会想做的事：

Name ("S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\" & Filename) ("S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\" & Filename & "!DNU!") 

我会建议将变量分配给路径，将它们称为oldpath和newpath。所以

Dim oldPath As String, newPath as String 

oldPath = "S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\" & sheetname & ".txt" 
newPath = "S:\MERIT OUTPUTS FOLDER\MSI Recruitment Limited\" & sheetname & "!DNU!.txt" 

Name oldPath newPath 

但是，该文件需要关闭之前，你可以这样做。因此，通过循环打开工作簿并关闭所有文件，确保文件已关闭。然后通过运行它，它应该将文件从旧名称重命名为新名称。

我会建议制作一个新的工作簿，并将其放置在桌面上，并在与真实代码/工作簿一起使用之前进行测试。制作一个新的工作簿，将其保存到桌面上，将其称为test.xlsx，然后关闭它。在单独的工作簿中，启动一个新的Sub并粘贴代码，但更改oldPath和newPath以反映您的桌面路径和test.xlsx文件。给这个镜头。