Move Excel file to parent folder and add suffix

[clogwyn]

Hi there -

Have an excel master template file with 2 sheets with a button on each with macro attached.

Button on sheet 1 saves a copy of the Excel master file to a folder and names it based on a certain input cell values in that sheet.

Button on sheet 2 saves another copy of a worksheet up one level to the parent folder, launches outlook and creates an email with an attachment of the worksheet.

These both work OK... but I actually need to move the Excel file (not save a copy) to the parent folder and also save it with a suffix to the filename based on the values of 2 cells in sheet 2. Also, I am repeating strings etc code filename, file path etc in the second Sub (strFilePathWIP and strFilePath as separate strings)

Do I need to rename it, then move it?

The first routine...

___

Sub SaveFile()

Dim strMyFile As String
Dim strFilePathWIP As String

'Get client
strMyFile = UCase(Sheets("sheet1").Range("B6").Value)
'Get title
strTitle = Replace(Application.Proper(Sheets("sheet1").Range("B4").Value), "'", "")
strMyFile = strMyFile & "_" & Application.Proper(strTitle)
'Get version
strMyFile = strMyFile & "_" & Trim(UCase(Replace(Application.Proper(Sheets("sheet1").Range("B5").Value), "/", "+")))
'MsgBox (strMyFile)
'Replace spaces with hyphens
strMyFile = Replace(strMyFile, " ", "-")
'Replace periods with hyphens
strMyFile = Replace(strMyFile, ".", "")
'Remove apostrophes
strMyFile = Replace(strMyFile, "'", "")
'MsgBox (strMyFile)

' Do not display the message about overwriting the existing file.
Application.DisplayAlerts = False
' Save the active workbook with the name of the active workbook.
strFilePathWIP = "N:\checktest\wipfolder" & strMyFile
ActiveWorkbook.SaveAs Filename:=strFilePathWIP
' Close the workbook by using the following.

End Sub

_____

And the second...

Sub SaveFile2()

Dim strMyFile As String
Dim strFilePath As String
Dim strBodyNotes As String
Dim strTitle As String

Dim oOLook As Object
Dim oEMail As Object

'Get client
strMyFile = UCase(Sheets("sheet1").Range("B6").Value)
'Get title
strTitle = Replace(Application.Proper(Sheets("sheet1").Range("B4").Value), "'", "")
strMyFile = strMyFile & "_" & Application.Proper(strTitle)
'Get version
strMyFile = strMyFile & "_" & Trim(UCase(Replace(Application.Proper(Sheets("sheet1").Range("B5").Value), "/", "+")))
'MsgBox (strMyFile)
'Replace spaces with hyphens
strMyFile = Replace(strMyFile, " ", "-")
'Replace periods with hyphens
strMyFile = Replace(strMyFile, ".", "")
'Remove apostrophes
strMyFile = Replace(strMyFile, "'", "")
'MsgBox (strMyFile)


' Do not display the message about overwriting the existing file.
Application.DisplayAlerts = False
' Save the active workbook with the name of the active workbook.
strFilePath = "N:\checktest\" & strMyFile
ActiveWorkbook.SaveAs Filename:=strFilePath
' Close the workbook by using the following.

Set oOLook = CreateObject("Outlook.Application")
oOLook.Session.Logon
Set oEMail = oOLook.CreateItem(0)
oEMail.Display
'
On Error Resume Next
With oEMail
If Sheets("sheet1").Range("B6").Value = "client1" Then
Else
.To = "clientname@domainname.com"
End If

.CC = "group1; group2"
.Subject = "QC: " & strMyFile
'strBodyNotes = "NOTES" + Chr(10)
'strBodyNotes = strBodyNotes + "------------------" + Chr(10)
'strBodyNotes = strBodyNotes + Sheets("checker").Range("A58").Value
'MsgBox (.Body)
'.Body = strBodyNotes + .Body
'MsgBox (strFilePath)
.Attachments.Add strFilePath & ".xls"
'.Send
End With
On Error GoTo 0
'

End Sub

____


I have looked at various commands for moving the file but not sure which would be best to use here (don't really want to use KILL on the file if possible).

Also, any help on streamlining the code down would be great - any help or suggestions much appreciated!

Cheers,

Rich