覆盖初始文件名

在一些地方有一些帮助,我写了下面的代码,完美的工作,但我需要能够覆盖最初的文件名(我们要求用GetOpenFilenameselect一个),以包括!DNU! 所以用户在select它之后就知道了,而不是再次select相同的文件,特别是因为他们将使用的文件都是非常相似的。 你可以看到我尝试了'重命名原始文本文件,但它没有做任何事情! 任何帮助,将不胜感激。

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 

在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!") 

我build议将variables分配给path,称之为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 

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

我会build议制作一个新的工作簿,并将其放置在桌面上,然后再使用真正的代码/工作簿进行testing。 制作一个新的工作簿,将其保存到桌面上,将其称为test.xlsx,然后closures它。 在单独的工作簿中,启动一个新的Sub并粘贴代码,但更改oldPath和newPath以反映您的桌面path和test.xlsx文件。 给这个一个镜头。