覆蓋初始文件名

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文件。給這個鏡頭。