Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 370
  • Last Modified:

Command button help

Please can you help: -

The attached code does everything I need it to except omit the "_0" from when it saves the file for the very first time.

It currently saves the file to: - C:\Documents and Settings\Administrator\My Documents\Gary\project\New Folder\

It then gives it the following file name:- "Summary_" & Format(Sheets("Low Volume").Range("C5").Value, "YYYY-MM-DD")
Extn = ".xls"

For example today’s file name would be: - “Summary_2011-02-15_0”

However I wish to amend the code so that the 1st output or recording would equal “Summary_2011-02-15”

Only was I try to save the same file name twice would the code save the worksheet as:-

“Summary_2011-02-15_1”

Third time would be “Summary_2011-02-15_2” etc


Please can you help, the command button is labelled "Archive" on my sheet
Private Sub CommandButton2_Click()
Dim strPath As String, strFileName As String
Dim Extn As String, strFname As String
Dim INUm As Long, CheckMe As Long

strPath = "C:\Documents and Settings\Administrator\My Documents\Gary\project\New Folder\"
strFileName = "Summary_" & Format(Sheets("Low Volume").Range("C5").Value, "YYYY-MM-DD")
Extn = ".xls"

strFname = Dir(strPath & strFileName & "_" & INUm & Extn)
Do While Len(strFname) <> 0
INUm = INUm + 1
strFname = Dir(strPath & strFileName & "_" & INUm & Extn)
Loop

Sheets("Low Volume").Copy
ActiveWorkbook.SaveAs Filename:=strPath & strFileName & "_" & INUm & Extn
ActiveWorkbook.Close
CheckMe = MsgBox("Clear Contents?", vbYesNo)
If CheckMe = vbYes Then

Sheets("Low Volume").Unprotect Sheets("DataSheet").Range("B2").Value
ThisWorkbook.ActiveSheet.Range("B14:K414,W14:W414,N14:N414,Q14:Q414").ClearContents
Sheets("Low Volume").Protect Sheets("DataSheet").Range("B2").Value
 End If
End Sub

Open in new window

gary-test3.xls
0
Gazza83
Asked:
Gazza83
  • 3
  • 2
1 Solution
 
StephenJRCommented:
Try changing line 10 to:

strFname = Dir(strPath & strFileName & Extn)

0
 
Gazza83Author Commented:
If I replace line 10 it then comes up with the command prompt... File already exists do you wish to replace it. If I click no then, VB goes into error
0
 
StephenJRCommented:
As well as the change above, replace line 17 with
If INUm = 0 Then
    ActiveWorkbook.SaveAs Filename:=strPath & strFileName & Extn
Else
    ActiveWorkbook.SaveAs Filename:=strPath & strFileName & "_" & INUm & Extn
End If

Open in new window

0
 
Gazza83Author Commented:
Thanks Stephen, seems to work really well. Has solved the "_0" issue

Private Sub CommandButton2_Click()
Dim strPath As String, strFileName As String
Dim Extn As String, strFname As String
Dim INUm As Long, CheckMe As Long

strPath = "C:\Documents and Settings\Administrator\My Documents\Gary\project\New Folder\"
strFileName = "Summary_" & Format(Sheets("Low Volume").Range("C5").Value, "YYYY-MM-DD")
Extn = ".xls"

strFname = Dir(strPath & strFileName & Extn)
Do While Len(strFname) <> 0
INUm = INUm + 1
strFname = Dir(strPath & strFileName & "_" & INUm & Extn)
Loop

Sheets("Low Volume").Copy
If INUm = 0 Then
    ActiveWorkbook.SaveAs Filename:=strPath & strFileName & Extn
Else
    ActiveWorkbook.SaveAs Filename:=strPath & strFileName & "_" & INUm & Extn
End If
ActiveWorkbook.Close
CheckMe = MsgBox("Clear Contents?", vbYesNo)
If CheckMe = vbYes Then

Sheets("Low Volume").Unprotect Sheets("DataSheet").Range("B2").Value
ThisWorkbook.ActiveSheet.Range("B14:K414,W14:W414,N14:N414,Q14:Q414").ClearContents
Sheets("Low Volume").Protect Sheets("DataSheet").Range("B2").Value
 End If
End Sub
0
 
StephenJRCommented:
Good, glad it worked.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now