Excel 更改工作簿名称的一部分并将文件另存为新名称

Excel 更改工作簿名称的一部分并将文件另存为新名称,excel,vba,Excel,Vba,在将工作簿保存为新文件之前,我正在尝试更改文件名(YY编号)。每个文件名的格式为:“HXXX-XXX-XXX-YY示例标题” YY是从0到无穷大的任意数字,其中YY总是从字符串中的14个字符开始 是否有办法获取原始文件名(代码中尝试),将YY编号更改为下一个连续编号,然后使用“新”文件名另存为 示例: 之前的标题:H019-018-072-2设备语言AS 预期结果:H019-018-072-3设备语言AS 我的代码部分在那里,但是我需要拆分字符串吗 Sub SaveAsNewFile1() Di

在将工作簿保存为新文件之前,我正在尝试更改文件名(YY编号)。每个文件名的格式为:“HXXX-XXX-XXX-YY示例标题”

YY是从0到无穷大的任意数字,其中YY总是从字符串中的14个字符开始

是否有办法获取原始文件名(代码中尝试),将YY编号更改为下一个连续编号,然后使用“新”文件名另存为

示例:
之前的标题:H019-018-072-2设备语言AS
预期结果:H019-018-072-3设备语言AS

我的代码部分在那里,但是我需要拆分字符串吗

Sub SaveAsNewFile1()
Dim filepath As String
Dim filename As String
Dim filepatharch As String
Dim filelist As String
Dim filedate As String
Dim filecount As Integer

'Set where to save and the file naming convention
filepath = "H:\BoM Drafts Macro\"
filename = ActiveWorkbook.Name

If InStr(filename, ".") > 0 Then
    Str1 = Left(filename, InStr(filename, ".") - 1)
End If

With CreateObject("Scripting.FileSystemObject")
    Debug.Print Mid$(.GetBaseName(Str1), 13)
End With

'"HXXX-XXX-XXX-.." & rest of name
filepatharch = "H:\BoM Drafts Macro\"

'Do While Len(Dir(filepatharch & filename)) <> 0
    'filecount = filecount + 1
    'hfilename = "STR1" & filename
'Loop

Sheets("Sheet1").Copy
ActiveWorkbook.SaveAs filename:= _
    "H:\BoM Drafts Macro\" & hfilename & ".xlsx"

ActiveWindow.Close

End Sub
Sub SaveAsNewFile1()
将文件路径设置为字符串
将文件名设置为字符串
Dim filepatharch作为字符串
将文件列表设置为字符串
将文件日期设置为字符串
Dim filecount为整数
'设置保存位置和文件命名约定
filepath=“H:\BoM草稿宏”
filename=ActiveWorkbook.Name
如果InStr(文件名“.”>0,则
Str1=Left(文件名,InStr(文件名“.”-1)
如果结束
使用CreateObject(“Scripting.FileSystemObject”)
调试.打印Mid$(.GetBaseName(Str1),13)
以
“HXXX-XXX-XXX-…”和名称的其余部分
filepatharch=“H:\BoM草稿宏”
'Do While Len(Dir(filepatharch&filename))0
'filecount=filecount+1
'hfilename=“STR1”&文件名
'循环
活页(“活页1”)。复印件
ActiveWorkbook.SaveAs文件名:=_
“H:\BoM草稿宏\”&hfilename&“.xlsx”
活动窗口,关闭
端接头

您需要进一步拆分文件名

你本能地在“.”处分裂以摆脱文件扩展名,这很好。接下来的步骤如下:

1) 提取标题,在本例中为“Device Language AS”,其操作如下

Title = Right(Str1, Len(Str1) - InStr(Str1, " "))
LastNum = Right(Left(Str1, Len(Str1) - Len(Title) - 1), Len(Str1) - Len(Title) - 14)
ShortName = Left(Str1, 13)
2) 提取最后一个文件的编号,即“2”,可按如下操作

Title = Right(Str1, Len(Str1) - InStr(Str1, " "))
LastNum = Right(Left(Str1, Len(Str1) - Len(Title) - 1), Len(Str1) - Len(Title) - 14)
ShortName = Left(Str1, 13)
3) 提取字符串的缩短版本,操作如下

Title = Right(Str1, Len(Str1) - InStr(Str1, " "))
LastNum = Right(Left(Str1, Len(Str1) - Len(Title) - 1), Len(Str1) - Len(Title) - 14)
ShortName = Left(Str1, 13)
在这些步骤之后,用于在“.”处拆分的if语句应如下所示:

If InStr(filename, ".") > 0 Then
Str1 = Left(filename, InStr(filename, ".") - 1)
Title = Right(Str1, Len(Str1) - InStr(Str1, " "))
LastNum = Right(Left(Str1, Len(Str1) - Len(Title) - 1), Len(Str1) - Len(Title) - 14)
ShortName = Left(Str1, 13)
End If
从这一点开始,您只需要将先前的“-YY”编号增加到新编号,然后可以使用现有代码将所有部分连接在一起,以新名称保存文件,操作如下

LastNum = CStr(CInt(LastNum) + 1)
Sheets("Sheet1").Copy
ActiveWorkbook.SaveAs filename:= _
filepath & ShortName & LastNum & " " & Title & ".xlsx"

ActiveWindow.Close