Message Box

[Kstalker]

So far so good, I just have one more (probably many more) conundrum to
solve.
The code below, supplied via this site, works perfectly. But I have to
make allowance for users requesting via command button the creation of
a new book twice in one day. Conflicting file name. By default I get
the windows File already exists prompt. How can I control this so that
i can direct the navigation if 'No' is selected.

Thanks again



Sub CreateArchive()

Dim Wb As Workbook
Dim ws As Worksheet
Dim sStr As String

Application.ScreenUpdating = True

Set Wb = Workbooks("Single Sheet.xls")
Set ws = Worksheets("Master")
sStr = Format(Date, "yymmdd") & " " & "Stage Clearer"

ws.Copy

ActiveWorkbook.SaveAs "G:\" & sStr

ActiveWorkbook.Close
Application.ScreenUpdating = False

End Sub

 

[anilsolipuram]

Backup your workbook before trying this macro.



Try this macro, this will prompt whether you want to overwrite , I yes
will overwrite, else it will close workbook without overwriting

Sub CreateArchive()

Dim Wb As Workbook
Dim ws As Worksheet
Dim sStr As String

Application.ScreenUpdating = True

Set Wb = Workbooks("Book1.xls")
Set ws = Worksheets("Sheet1")
sStr = Format(Date, "yymmdd") & " " & "Stage Clearer"

ws.Copy

If file_exist("g:\" & sStr & ".xls") Then
MsgBox "Do you want to overwrite the file", vbYesNo
If vbYes Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "g:\" & sStr
Application.DisplayAlerts = True
End If
Else
ActiveWorkbook.SaveAs "g:\" & sStr
End If
ActiveWorkbook.Close
Application.ScreenUpdating = False
End Sub

Function file_exist(str As String)
If Len(Dir(str)) > 0 Then
file_exist = True
Else
file_exist = False
End If
End Function

 

[Norman Jones]

Hi Kristan,

You already have a response, but a question: if an archive copy of the file
alredy exists, do you want always to disallow second (or subsequent) saves?

Incidentally, in your copied code (and in Anil's response), you should
reverse the logic of the Application.ScreenUpdating statements. This should
be set to False at the start and True at the end.

 

[Kstalker]

Thanks for that. As predicted I have hit another wall

I am trying to run another sub dependent on Yes/No, but regardless o
selection it runs.

How can I prevent this?


Sub CreateArchive()

Dim Wb As Workbook
Dim ws As Worksheet
Dim sStr As String

Application.ScreenUpdating = True

Set Wb = Workbooks("Single Sheet.xls")
Set ws = Worksheets("Master")
sStr = Format(Date, "yymmdd") & " " & "Stage Clearer"

ws.Copy


If file_exist("G:\") Then
MsgBox "This file already Exists. Do you want to overwrite it?"
vbYesNo
If vbYes Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "G:\\" & sStr
ActiveWorkbook.Close

COMPILE_DATA.COPYUSEDRANG

Application.DisplayAlerts = True
End If

Else

ActiveWorkbook.SaveAs "G:\ & sStr
Worksheets("navigation").Select
End If

Application.ScreenUpdating = False

End Sub

Thanks agai

 

[anilsolipuram]

try this macro

it should be If file_exist("G:\" & sStr & ".xls") Then instead of
If file_exist("G:\" ) Then




Sub CreateArchive()

Dim Wb As Workbook
Dim ws As Worksheet
Dim sStr As String

Application.ScreenUpdating = True

Set Wb = Workbooks("Single Sheet.xls")
Set ws = Worksheets("Master")
sStr = Format(Date, "yymmdd") & " " & "Stage Clearer"

ws.Copy


If file_exist("G:\" & sStr & ".xls") Then
MsgBox "This file already Exists. Do you want to overwrite it?"
vbYesNo
If vbYes Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "G:\\" & sStr
ActiveWorkbook.Close

compile_data.CopyUsedRange

Application.DisplayAlerts = True
End If

Else

ActiveWorkbook.SaveAs "G:\ & sStr
Worksheets("navigation").Select
End If

Application.ScreenUpdating = False

End Su

 

[Kstalker]

Hi Norman.

Cheers for the input, will reverse the application.Statusupdating.

The saved file is date stamped in file name and the user should ideall
be only archiving weekly. So I am really trying to give them as man
chances as possible to think about overwritting existing archive fo
that day.



Regards

Krista

 

[Norman Jones]

Hi Anil,

MsgBox "This file already Exists. Do you want to overwrite it?",
vbYesNo
If vbYes Then

Using this code, Kristan's file will be overwritten both if the user agrees
or disagrees. I think that you could rewrite this as:

Dim Res as long

Res = MsgBox("This file already Exists. " & _
"Do you want to overwrite it?", vbYesNo)
If Res = vbYes Then

---
Regards,
Norman



"anilsolipuram" <[email protected]>
wrote in message

 

[Guest]

a simple reply:

Option Explicit
Sub CreateArchive()

Dim Wb As Workbook
Dim ws As Worksheet
Dim newWB As Workbook
Dim sStr As String

Application.ScreenUpdating = True

Set Wb = ThisWorkbook ' Workbooks("Single Sheet.xls")
Set ws = Worksheets("Master")
sStr = "G:\" & Format(Date, "yymmdd") & " " & "Stage Clearer"
ws.Copy

If Dir(sStr) = "" Then
ActiveWorkbook.SaveAs "G:\" & sStr
Else
sStr = Application.GetSaveAsFilename()
If UCase(sStr) <> "false" Then
ActiveWorkbook.SaveAs sStr
End If

End If
ActiveWorkbook.Close
Application.ScreenUpdating = False

End Sub

 

[Kstalker]

Thanks Anil, Norman and Patrick.

I am now unfortunately greeted with a runtime error for the 'ws.copy'

Further help would be greatly appreciated.


Sub CreateArchive()

Dim Wb As Workbook
Dim ws As Worksheet
Dim sStr As String
Dim Res As Long

Application.ScreenUpdating = False

Set Wb = Workbooks("Single Sheet.xls")
Set ws = Worksheets("Master")
sStr = Format(Date, "yymmdd") & " " & "Stage Clearer"

ws.Copy

If file_exist("G:" & sStr & ".xls")") Then

Res = MsgBox("This file already Exists. " & _
"Do you want to overwrite it?", vbYesNo)
If Res = vbYes Then


Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "G:\" & sStr
ActiveWorkbook.Close

compile_data.CopyUsedRange

Application.DisplayAlerts = True
End If

Else


ActiveWorkbook.SaveAs "G:\" & sStr
Worksheets("navigation").Select
End If

Application.ScreenUpdating = True

End Sub

Function file_exist(str As String)
If Len(Dir(str)) > 0 Then
file_exist = True
Else
file_exist = False
End If
End Function


Thanks Again

 

[Kstalker]

Problem solved. SP1 was not installed on the terminal.

Code works a treat with one niggle left. I am left with a workbook open
and untitled when the user does not want to overwrite the file.

How can I remove this?

Again, thanks.

 

[anilsolipuram]

Backup the workbook before trying this macro.

I am assuming that you just want to close the file, if user doesnot
want to overwrite.

Sub CreateArchive()

Dim Wb As Workbook
Dim ws As Worksheet
Dim sStr As String
Dim Res As Long

Application.ScreenUpdating = False

Set Wb = Workbooks("Single Sheet.xls")
Set ws = Worksheets("Master")
sStr = Format(Date, "yymmdd") & " " & "Stage Clearer"

ws.Copy

If file_exist("G:" & sStr & ".xls")") Then

Res = MsgBox("This file already Exists. " & _
"Do you want to overwrite it?", vbYesNo)
If Res = vbYes Then


Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "G:\" & sStr
ActiveWorkbook.Close

compile_data.CopyUsedRange

Application.DisplayAlerts = True
Else
Application.DisplayAlerts = False
ActiveWorkbook.Close

Application.DisplayAlerts = true

end if


Else


ActiveWorkbook.SaveAs "G:\" & sStr
Worksheets("navigation").Select
End If

Application.ScreenUpdating = True

End Sub