How to implement creating a folder and saving a file with the name from the text in the file

Question

The essence of the problem is as follows: there is an estimate that the program displays, the estimate contains the number of this estimate that looks like 00-00-0-00-00, this number is always in the same cell with the text and may look like 3 options: LOCAL ESTIMATE CALCULATION No. 00-00-0-00-00, or ESTIMATE CALCULATION No. 00-00-0-00-00, or LOCAL ESTIM No. 00-00-0-00-00. It is necessary to isolate the calculation number, call the List for them, then subtract the last 3 characters from the calculation number - this will be the Object number of the type (00-00-0-00), create a folder on the desktop under the object number and save the file with the name of the calculation number (00-00-0-00-00). The code below coped with this perfectly, until the text indicating the correction Kn of the type (00-00-0-00-00 Кn) was added to the number, where n is the correction number is always a one-digit number, i.e. maximum K9, and And - all the same thing only AND - change. I already broke my head how to implement it.

Sub xxx () Dim НомерОбъекта As String Dim НомерЛокального As String If Cells.Find(What:="СМЕТНЫЙ РАСЧЕТ № ", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) Is Nothing Then If MsgBox("Отсутствует фраза _СМЕТНЫЙ РАСЧЕТ №_. Макрос будет прерван!", vbCritical + vbOKOnly) = vbOK Then End Else End If Else НомерЛокального = Right(Cells.Find(What:="СМЕТНЫЙ РАСЧЕТ № ", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False), 13) Range("C1") = НомерЛокального НомерОбъекта = Mid(НомерЛокального, 1, 10) Range("C2") = НомерОбъекта ActiveSheet.Name = НомерЛокального folder = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & НомерОбъекта & "\" On Error Resume Next: MkDir folder ActiveWorkbook.SaveAs folder & НомерЛокального & ".xls" Application.CutCopyMode = False ' очищение буфера обмена End If End Sub

2. The name of the sheet and the file should be the same as it was before?
The name of the sheet, file and folder should correspond to the number from the estimate, if it is with the letter K, that is, the estimate was corrected for the first time and K1 was added to its number.

Dmitry Kutyrkin 46 9 · Accepted Answer · 2017-03-01T19:54:48

As a solution, you can check the third character to the left for equality of the space, and based on this, select the number.

In order not to use unnecessary branches to create a file name, you can use the feature of the mid function, that if the start parameter is greater than the length of the string, then an empty string is returned, and if you do not specify the length parameter, then all characters to the end of the string are selected.

Also, instead of using the slash character when creating the path, it is better to use Application.PathSeparator . I cite the code with minimal changes.

 Sub xxx () Dim НомерОбъекта As String Dim НомерЛокального As String Dim ЯчейкаНомера As Range Dim ЗнаковВНомере As Integer Set ЯчейкаНомера = Cells.Find(What:="СМЕТНЫЙ РАСЧЕТ № ", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If ЯчейкаНомера Is Nothing Then MsgBox "Отсутствует фраза _СМЕТНЫЙ РАСЧЕТ №_. Макрос будет прерван!", vbCritical + vbOKOnly End Else ЗнаковВНомере = IIf(Mid(ЯчейкаНомера.Value, Len(ЯчейкаНомера.Value) - 2, 1) = " ", 16, 13) НомерЛокального = Right(ЯчейкаНомера.Value, ЗнаковВНомере) НомерОбъекта = Mid(НомерЛокального, 1, 10) & Mid(НомерЛокального, 14) ActiveSheet.Name = НомерЛокального folder = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator & НомерОбъекта & Application.PathSeparator On Error Resume Next: MkDir folder ActiveWorkbook.SaveAs folder & НомерЛокального & ".xls" Application.CutCopyMode = False Set ЯчейкаНомера = Nothing End If End Sub

Edward, thank you for the idea - it worked (see my answer to your own question), but this particular code does not work, or you did not fully understand me (what I want).
@ Dmitry Kutyrkin understood your desires, corrected the code.
Yes, now the code works as needed and is much more concise than mine, thanks!

Answer 2 · 2017-03-01T19:16:24

The problem is not clear. Perhaps the space in the file name is in the way (hardly ...). Try replacing with "_". More obvious reasons are not visible.

A few notes on the code.

Variable names. Yes, they must "tell", for which they are responsible. But too long names make it difficult to read the code.

Do not use reserved words as names, this can lead to trouble.

Folders can be created without using CreateObject :

 Dim sPathFldr As String sPathFldr = ThisWorkbook.Path & "\НомерОбъекта\" ' путь к папке If Dir(sPathFldr, vbDirectory) = "" Then MkDir sPathFldr ' создаем, если нет

How to be if the space has to stand strictly, add it in some way afterwards?
There is still a hitch in which, I’m Right, counting 13 characters to the right (because the estimate number is strictly 13 characters), and if the estimate with the K1 correction is valid, then 3 more characters are added, and by counting 13 I get nonsense, if you put it in stock 16, then it is necessary to delete the text that will fall into the last characters, if the number is without K1.
sometimes, instead of K, it can be And, it seems to me easier to check the third character on the right for equality of a space
if the number is without K and I, the third character on the right will also be a space!

How to implement creating a folder and saving a file with the name from the text in the file

2 answers 2

More articles: