Macro Save File Name With Specific Name

[muhammad susanto]

hi all..
how to edit this macro code:

Sub SaveToFolder()
ChDir "C:\Test\"
MyName = ActiveWorkbook.Name
ActiveWorkbook.SaveAs Filename:=Sheets("Sheet1").Cells(1, 1) & " - " & MyName
End Sub

the macro working ok, i want to save file name like this:
LPK-3-014 (original file name)
hitung LPK-3-014 ok (after run macro)

thank in advance.
.sst

 

[Joe4]

Just change this line:

ActiveWorkbook.SaveAs Filename:=Sheets("Sheet1").Cells(1, 1) & " - " & MyName

to this:

ActiveWorkbook.SaveAs Filename:="hitung " & Sheets("Sheet1").Cells(1, 1) & " - " & MyName & " ok"

 

[muhammad susanto]

hi

Just change this line:

ActiveWorkbook.SaveAs Filename:=Sheets("Sheet1").Cells(1, 1) & " - " & MyName

to this:

ActiveWorkbook.SaveAs Filename:="hitung " & Sheets("Sheet1").Cells(1, 1) & " - " & MyName & " ok"

Joe4,..your code not fully work
after run macro the result :
1.xlsx (original name file)
hitung - 1.xlsx ok (after run macro)- "the extension file is gone

 

[Joe4]

hitung - 1.xlsx ok (after run macro)- "the extension file is gone

Its there, it is just before the "ok".

Try this version:

Sub SaveToFolder()
ChDir "C:\Test\"
MyName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)
ActiveWorkbook.SaveAs Filename:="hitung " & Sheets("Sheet1").Cells(1, 1) & " - " & MyName & " ok.xlsx"
End Sub

 

[muhammad susanto]

hi thank you, working 100%

 

[Joe4]

You are welcome.

 

[Joe4]

The code I gave you works specifically for files that have file extensions exactly 4 characters long. However, we can generalize so it would work for any 3 character file extensions (or any number, really), like this:

Sub SaveToFolder()
    Dim e As Long
    Dim ext As String

    ChDir "C:\Test\"
    e = InStrRev(ActiveWorkbook.Name, ".")  'find position of last period in file name
    ext = Mid(ActiveWorkbook.Name, e + 1)  'extract file name extension
    MyName = Left(ActiveWorkbook.Name, e - 1)  'extract original file name without extension
    ActiveWorkbook.SaveAs Filename:="hitung " & Sheets("Sheet1").Cells(1, 1) & " - " & MyName & " ok." & ext
End Sub