System Variables so I do not need to Hard code a path to save file to a fold in the documents area.

[ShawnSPS]

Hello,



I am leaving you the above two codes. What I am trying to setup is a system variable for two of my Macros – one is called “Archive”& the other is called “SaveNextMonth”



The Idea is not have to hard code a path in the macro for each computer that the workbook is on. For those two Macros.



With the “Archive” Macro: I need it to save the zNotes worksheet into the folder called Archive Notes in the documents on the computer. and the clear the data with the range that I have give it. this is what I have write currently for “archive” how ever its not clearing out the data.



Sub archive()
Dim SavePath As String
ActiveSheet.Copy
SavePath = Environ("userprofile") & "\my documents\Archive Notes\zNotes.xls"
Application.DisplayAlerts = False
ActiveSheet.SaveAs SavePath
Range("b2:d5000").Clear
ActiveWorkbook.Close
End Sub




SaveNextMonth I haven’t got to it yet because of the issue with the “archive” Macro

But here is the current Macro: its basic the same concept that I need where the system variable is copying the workbook to a folder called Office Counts and then clearing out the data with the range I give it .. this Macro is current work but I don’t want to hard code a path – I want the system do to the work other I have go each computer and enter its path Manually which why the system Variable make more sense because it not OS dependant



Any direction would be helpful than you


Sub SaveNextMonth()
Application.ScreenUpdating = False
Dim mon As String, nextMon As String, fName As String, ws As Worksheet
mon = MonthName(Month(Date))
nextMon = MonthName(Month(Date) + 1)
If MsgBox("The current month will change to " & nextMon & " and all data from the previous month will be deleted. Are you sure you want to change the month and clear all data?", vbYesNo) = vbYes Then
fName = InputBox("Enter the file name to be used.")
If fName = "" Then Exit Sub
ActiveWorkbook.SaveCopyAs Filename:="C:\Users\Shawn\Desktop\2023 Counts\" & fName & ".xls"
For Each ws In Sheets
If ws.Name <> "Ablank" And "ws.Name" <> "Zdata" And "ws.Name" <> "ZShortCuts" Then
With ws
.Unprotect ("Pila1DA.#")
.Range("A1") = nextMon
.Range("D3:AH31,D34:AH41").ClearContents
.Protect ("Pila1DA.#")
End With
End If
Next ws
End If
ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub

 

[ShawnSPS]

There is nothing in the code to save the year.

the code for SaveNextMonth using the same variable code that "archive" is using. when I use the macro ...every works except it saving the file and saving it into the folder. have tried this multiple times and I get the same response. no errors however so have nothing to go by

 

[Fluff]

every works except it saving the file and saving it into the folder

Not sure what you mean by this. If it's saving the file in the correct folder what's the problem?

 

[ShawnSPS]

Not sure what you mean by this. If it's saving the file in the correct folder what's the problem?

sorry typing error the code itself works except its not saving the file in the designated folder.

 

[Fluff]

Then where is it being saved?

 

[ShawnSPS]

Then where is it being saved?

Good Question. it should have my default saved in my documents even if it could reach the folder. but when I did a search for the file that I named it. it did not find it at all on the computer.

 

[Fluff]

What is the code you are currently using?
When posting code please use code tags How to Post Your VBA Code

 

[ShawnSPS]

What is the code you are currently using?
When posting code please use code tags How to Post Your VBA Code

Sub SaveNextMonth()
    Application.ScreenUpdating = False
    Dim mon As String, nextMon As String, fName As String, ws As Worksheet
    mon = MonthName(Month(Date))
    nextMon = MonthName(Month(Date) + 1)
    If MsgBox("The current month will change to " & nextMon & " and all data from the previous month will be deleted. Are you sure you want to change the month and clear all data?", vbYesNo) = vbYes Then
        fName = InputBox("Enter the file name to be used.")
        If fName = "" Then Exit Sub
        SavePath = Environ("userprofile") & "\my documents\Office Counts\"
        For Each ws In Sheets
            If ws.Name <> "Ablank" And "ws.Name" <> "Zdata" And "ws.Name" <> "ZShortCuts" Then
                With ws
                    .Unprotect ("Pila1DA.#")
                    .Range("A1") = nextMon
                    .Range("D3:AH31,D34:AH41").ClearContents
                    .Protect ("Pila1DA.#")
                End With
            End If
        Next ws
    End If
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
End Sub

Blankcount4.xls

Shared with Dropbox

www.dropbox.com

 

[Fluff]

You've removed the line that does the SaveCopyAs which is why it's not saving anything

 

[ShawnSPS]

You've removed the line that does the SaveCopyAs which is why it's not saving anything

I have entered the savecopyas see code below

I get a run time error '1004' method 'savecopyas' of object '_workbook" failed

Sub SaveNextMonth()
    Application.ScreenUpdating = False
    Dim mon As String, nextMon As String, fName As String, ws As Worksheet, SavePath As String
    mon = MonthName(Month(Date))
    nextMon = MonthName(Month(Date) + 1)
    If MsgBox("The current month will change to " & nextMon & " and all data from the previous month will be deleted. Are you sure you want to change the month and clear all data?", vbYesNo) = vbYes Then
        fName = InputBox("Enter the file name to be used.")
        If fName = "" Then Exit Sub
        ActiveWorkbook.SaveCopyAs
        SavePath = Environ("userprofile") & "\my documents\Office Counts\"
        For Each ws In Sheets
            If ws.Name <> "Ablank" And "ws.Name" <> "Zdata" And "ws.Name" <> "ZShortCuts" Then
                With ws
                    .Unprotect ("Pila1DA.#")
                    .Range("A1") = nextMon
                    .Range("D3:AH31,D34:AH41").ClearContents
                    .Protect ("Pila1DA.#")
                End With
            End If
        Next ws
    End If
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

It should be

ActiveWorkbook.SaveCopyAs Filename:=Environ("userprofile") & "\my documents\Office Counts\" & fName & ".xls"