重命名一个excel文件并将其保存到VBA的相对path
我有一个工作簿，我通过我录制的macros进行格式化。 macros目前重命名文件并将其保存到一个常量path，但我需要它重命名该文件并将其保存到相对path，以便其他队友可以使用它。 有什么build议吗？
这是活动文件
Windows("Manual Reconciliation Template.xlsm").Activate 这是不变的path
ActiveWorkbook.SaveAs FileName:= _ "C:\Users\e6y550m\Documents\MANUAL RECS\Manual Reconciliation Template.xlsm", _ FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
当前代码：
Sub Name_And_Save_Report() ' ' TO NAME, DATE AND SAVE THE REPORT AFTER IT HAS BEEN WORKED. ' Windows("Manual Reconciliation Template.xlsm").Activate Dim thisWb As Workbook Dim fname fname = InputBox("Enter your name (example-John):") Set thisWb = ActiveWorkbook Workbooks.Add ActiveWorkbook.SaveAs FileName:=thisWb.Path & "\" & fname & "_Manual Recon" & " " & Format(Date, "MM.DD.YY") & ".xlsx" ActiveWorkbook.Close savechanges:=False Windows("Manual Reconciliation Template.xlsm").Activate ActiveWorkbook.Close savechanges:=False End Sub
因此，您将在每个个人文件夹中粘贴包含上述代码的工作簿副本。 当他们打开工作簿时，要将其重命名为：
<<人名>> _Manual Recon << mm.dd.yy >> .xlsx
我假设你想把原来的文件留在那里，这样他们就可以打开它，并在第二天创build一个新的xlsx，但是如果它已经存在（如果它们在一天内打开xlsm两次），不会创build一个文件。
还有一点需要考虑 – 是他们的个人文件夹给他们的名字？
例如G:\MMS Trade Payables\John
我注意到在你的代码中，你设置一个variablesthisWb等于ActiveWorkbook 。
您可以使用ThisWorkbook ，它始终引用该代码正在运行的工作簿。
所以有了这些假设，试试这个代码：
Sub Name_And_Save_Report() Dim fName As String Dim sNewFile As String 'Get the folder name. fName = GetParentFolder(ThisWorkbook.Path) 'Could also get the Windows user name. 'fName = Environ("username") 'Or could get the Excel user name. 'fname = application.username 'Or could just ask them. 'fname = InputBox("Enter your name (example-John):") sNewFile = ThisWorkbook.Path & Application.PathSeparator & _ fName & "_Manual Recon " & Format(Date, "mm.dd.yy") & ".xlsx" If Not FileExists(sNewFile) Then 'Turn off alerts otherwise you'll get '"The following features cannot be saved in macro-free workbooks...." '51 in the SaveAs means save in XLSX format. Application.DisplayAlerts = False ThisWorkbook.SaveAs sNewFile, 51 Application.DisplayAlerts = True End If End Sub Public Function FileExists(ByVal FileName As String) As Boolean Dim oFSO As Object Set oFSO = CreateObject("Scripting.FileSystemObject") FileExists = oFSO.FileExists(FileName) Set oFSO = Nothing End Function Public Function GetParentFolder(ByVal FilePath As String) As String Dim oFSO As Object Set oFSO = CreateObject("Scripting.FileSystemObject") GetParentFolder = oFSO.GetFolder(FilePath).Name Set oFSO = Nothing End Function
我将在这里作为我的第一个答案：
你的意思是这样吗？
使用FileSystemObjectrecursion获取父文件夹名称。
Sub Test() MsgBox ThisWorkbook.Path & vbCr & RelativePath(ThisWorkbook.Path, 2) 'Will return "C:\Users\e6y550m" - step back 2 folders. MsgBox RelativePath("C:\Users\e6y550m\Documents\MANUAL RECS\", 2) 'Your line of code: 'ActiveWorkbook.SaveAs FileName:=RelativePath(thisWb.Path, 2) & "\" & fname & "_Manual Recon" & " " & Format(Date, "MM.DD.YY") & ".xlsx" End Sub 'FilePath - path to file, not including file name. 'GetParent - the number of folders in the path to go back to. Public Function RelativePath(FilePath As String, Optional GetParent As Long) As String Dim oFSO As Object Set oFSO = CreateObject("Scripting.FileSystemObject") 'If rightmost character is "\" then we've reached the root: C:\ If GetParent = 0 Or Right(FilePath, 1) = Application.PathSeparator Then RelativePath = oFSO.GetFolder(FilePath) 'If we've reached the root then remove the "\". If Right(RelativePath, 1) = Application.PathSeparator Then RelativePath = Left(RelativePath, Len(RelativePath) - 1) End If Else 'GetParent is greater than 0 so call the RelativePath function again with 'GetParent decreased by 1. RelativePath = RelativePath(oFSO.GetParentFolderName(FilePath), GetParent - 1) End If Set oFSO = Nothing End Function
如果我的问题不清楚，我很抱歉; 充其量我是VBA新手。
'这是当前已经打开的文件，
Windows("Manual Reconciliation Template.xlsm").Activate
“我想和我的队友分享这个文件，以便他们可以使用它。 他们都有不同的文件夹。 我将在每个文件夹中放置一份该工作簿的副本。 当他们使用个人文件夹中的副本时，macros需要重命名该工作簿并将重命名的副本保存在其个人文件夹中。 因此，macros需要代码，将重命名该工作簿并将其保存在其文件夹中没有一个定义的path。 共享的驱动器path是G：\ MMS贸易应付款。 在MMS Trade Payables文件夹内是个人文件夹。 我认为代码只需要激活已打开的当前工作簿，重命名并将其保存在当前文件夹中，而不是.xlsm .xlsx。
当前代码：
Sub Name_And_Save_Report() ' ' TO NAME, DATE AND SAVE THE REPORT AFTER IT HAS BEEN WORKED. ' Windows("Manual Reconciliation Template.xlsm").Activate Dim thisWb As Workbook Dim fname ' Will use the fname variable to add the associates name to the file name (ex:If the associate enters Mark into the inputbox, fname will = Mark). fname = InputBox("Enter your name (example-John):") ' Makes thisWb = "Manual Reconciliation Template.xlsm". Set thisWb = ActiveWorkbook Workbooks.Add ' Saves the active workbook ("Manual Reconciliation Template.xlsm") to the path of thisWb and renames the workbook by adding the fname value and the current date (ex: if the associate entered Mark as the value of fname, "Manual Reconciliation Template.xlsm" becomes "Mark_Manual Recon 7.14.17.xlsx"). ActiveWorkbook.SaveAs FileName:=thisWb.Path & "\" & fname & "_Manual Recon" & " " & Format(Date, "MM.DD.YY") & ".xlsx" ' Closes the renamed workbook. ActiveWorkbook.Close savechanges:=False ' Calls the original workbook and closes it. Windows("Manual Reconciliation Template.xlsm").Activate ActiveWorkbook.Close savechanges:=False End Sub
当然，由于我是VBA的新手，这可能是完全错误的。