saving to network drive

[hopr37]

I have a module that saves to a network drive whenever I open the workbook. The problem is the code gives me an error when I try to open the saved file. the code is from a forum post on a different website

Private Sub Workbook_Open()
'Sub SaveToLocations()
ActiveWorkbook.SaveCopyAs "\\svr-files\files\pub_data\HTC Outside Plant\HTC Cable Count\backup" + ActiveWorkbook.Name
ActiveWorkbook.Save
End Sub

It saves it to the backup folder with the name "test.xlsm- That works fine

when I open the backup file I get a debug error. I'm Assuming because it's trying to make a backup in the backup folder with a file I have opened.
is there a way to stop this error?

 

[hotabae]

I'm so sorry for all the spam replies...

I haven't been testing the results at all. Here is my final answer:

Sub saveWbCopy()

Dim currentPath As String
Dim duplicateCount As Long
duplicateCount = 0
Dim saveSuccess As Boolean
saveSuccess = False
Dim directory As String
Dim modifier As String

directory = "\\svr-files\files\pub_data\HTC Outside Plant\HTC Cable Count\backup\"
modifier = "(" & DatePart("m", Date) & "_" & DatePart("d", Date) & "_" & DatePart("yyyy", Date) & ")" & ActiveWorkbook.Name
currentPath = directory & modifier

Do While saveSuccess = False
If Dir(currentPath) <> "" Then
    duplicateCount = duplicateCount + 1
    currentPath = directory & "(" & duplicateCount & ")" & modifier
Else
    ActiveWorkbook.SaveCopyAs currentPath
    saveSuccess = True

End If
Loop

End Sub

 

[hopr37]

It saved the file but when I went to open the original again I got an error

getting debug error on this line:

ActiveWorkbook.SaveCopyAs currentPath

This is what happens:
makes a copy called: (4_25_2018)working.xlsm
Try to open original. get's debug error

Go to backup folder and open the backup. Works. It also makes another backup called (4_25_2018)(4_25_2018)working.xlsm and then (4_25_2018)(4_25_2018)(4_25_2018)working.xlsm etc....
I can't open the original or the first backup ( (4_25_2018)working.xlsm) without getting a debug error.

I can however open up the newest backup with no errors. So it seems that any "first" backup gives the debug error.
But I like where you're going with this.

 

[hopr37]

sorry. Not a debug error but a runtime error. "Can't find (4_25_2018)working.xlsm"

 

[hotabae]

It saved the file but when I went to open the original again I got an error

getting debug error on this line:

ActiveWorkbook.SaveCopyAs currentPath

This is what happens:
makes a copy called: (4_25_2018)working.xlsm
Try to open original. get's debug error

Go to backup folder and open the backup. Works. It also makes another backup called (4_25_2018)(4_25_2018)working.xlsm and then (4_25_2018)(4_25_2018)(4_25_2018)working.xlsm etc....
I can't open the original or the first backup ( (4_25_2018)working.xlsm) without getting a debug error.

I can however open up the newest backup with no errors. So it seems that any "first" backup gives the debug error.
But I like where you're going with this.

I reworked this a bit. It shouldn't duplicate the date anymore. As far as the broken original goes... Are you trying to open it while the others are still open? Can you debug the error to figure out which line is causing problems? Mine appears to be working as expected.

Private Sub Workbook_Open()

Dim currentPath As String
Dim duplicateCount As Long: duplicateCount = 0
Dim saveSuccess As Boolean: saveSuccess = False


Dim directory As String
directory = [LEFT][COLOR=#333333][FONT=monospace]"\\svr-files\files\pub_data\HTC Outside Plant\HTC Cable Count\backup\"

[/FONT][/COLOR][/LEFT]
Dim fileName As String
fileName = ActiveWorkbook.Name


Dim dateString As String
dateString = "(" & DatePart("m", Date) & "_" & DatePart("d", Date) & "_" & DatePart("yyyy", Date) & ")"


If InStr(1, fileName, dateString) Then
    dateString = ""
End If


Do While saveSuccess = False

If Dir(currentPath) <> "" Then

    duplicateCount = duplicateCount + 1
    currentPath = directory & "(" & duplicateCount & ")" & dateString & filename

Else

    ActiveWorkbook.SaveCopyAs currentPath
    saveSuccess = True


End If

Loop

End Sub

 

[hopr37]

That works awesome!
Thank you so much for all your help!