宏编码，如何自动将文档重命名为上述文件夹名称

Question

我希望Word VBA宏将文档重命名为它所在的文件夹。

Sub SaveAsDOCX()
'
OpenDocName = ActiveDocument.FullName
lengthFileName `enter code here`= Len(OpenDocName)
OpenDocName = Left(OpenDocName, lengthFileName - 4)
'
ChangeFileOpenDirectory (ActiveDocument.Path & "\")
ActiveDocument.SaveAs2 FileName:=(OpenDocName & ".docx"), 
FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", 
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, 
EmbedTrueTypeFonts:=False, SaveFormsData:=False, 
SaveAsAOCELetter:=False, CompatibilityMode:=0
ActiveWindow.Close
End Sub

现在，代码将DOCX重命名为旧文件名，但我想从目录中提取文件夹名称，并重命名该文档。不幸的是，我需要这个宏在许多不同的文件夹中运行，所以我需要它保持动态，并且不能使用显式的文件夹路径。

Answer 1

‘该行获取文档所在文件夹的完整路径。

 ThisDocument.path

‘该行将FullPath获取到文档所在位置

ThisDocument.FullName

示例一，您可以为名称document创建一个新字符串

 dim docpath as string
 Dim docname As String
docname = VBA.Split(VBA.Mid(ActiveDocument.FullName, VBA.InStrRev(ActiveDocument.FullName, "\") + 1), ".")(0)
DocPath = ThisDocument.Path & "\" & docname &  ".docx"

示例2

dim docpath as string
 Dim docname As String
docname = Vba.Split(ActiveDocument,".")(0)
DocPath = ThisDocument.Path & "\" & docname &  ".docx"

我不知道是不是你想要的，请在下面评论，如果这对你有帮助，我想帮助你！

Answer 2

实际上非常简单。使用ActiveDocument获取路径字符串，将其拆分，ubound到顶部，-1在数组中定位父文件夹名称，然后调用生成的字符串。结束代码如下所示：

Dim name, nameSplit, ParentFolderName
OpenDocName = ActiveDocument.FullName
nameSplit = Split(OpenDocName, "\")
ParentFolderName = (UBound(nameSplit) - 1)

然后在执行SaveAs2时，以FileName:=的身份调用以下代码

(nameSplit(ParentFolderName) & ".docx")