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

时间:2019-09-25 16:30:55

标签: excel vba

作为宏的一部分,我试图在将工作簿另存为新文件之前更改文件名(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

1 个答案:

答案 0 :(得分:0)

您将需要进一步分割文件名。

您的分裂本能。摆脱文件扩展名是好的。下一步如下:

1)提取标题,在这种情况下为“设备语言AS”,可以按以下步骤操作

Title = Right(Str1, Len(Str1) - InStr(Str1, " "))

2)提取最后一个文件的编号,即“ 2”,如下所示

LastNum = Right(Left(Str1, Len(Str1) - Len(Title) - 1), Len(Str1) - Len(Title) - 14)

3)提取字符串的简化版本,方法如下:

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