How to save copy of file on desktop?

Posted by Art J. Wills on December 09, 2000 10:29 PM

Hello..

I would like to save a copy of the current open file on the desktop with the savename being a cell (last name of client) using VB. I made a control, this code does the trick but I don't know how to: 1) make the new file have the .XLS extension (saved file doesn't have extension) and 2) make CHDIR work to put the file on the desktop. Any help would be highly appreciated!

A.
NON WORKING SCRIPT:
Private Sub CommandButton2_Click()

ThisFile = Range("E6").Value
Chdir:="C:\Windows\Desktop\"
ActiveWorkbook.SaveCopyAs Filename:=ThisFile

End Sub

Posted by Ivan Moala on December 09, 2000 11:04 PM

ThisFile = Range("E6").Value Chdir:="C:\Windows\Desktop\" ActiveWorkbook.SaveCopyAs Filename:=ThisFile End Sub

One way to do it is ;

ThisFile = Range("E6").Value
savedir = "C:\Windows\Desktop\"
ActiveWorkbook.SaveCopyAs FileName:=savedir & ThisFile & ".xls"

Ivan

Posted by Aladin Akyurek on December 10, 2000 12:24 AM

ThisFile = Range("E6").Value Chdir:="C:\Windows\Desktop\" ActiveWorkbook.SaveCopyAs Filename:=ThisFile End Sub

Ivan,

Is it also possible to copy automatically to a floppy in A:\ after, say 45 minutes? What I'm asking for is additional VB code. I could use the code during examinations. I've always 3 to 4 students who forget to save or can't save their workbook to A:\.

Thanks.

Aladin

Posted by Ivan Moala on December 10, 2000 1:35 AM

Aladin, this should help you;

Public RunWhen As Double
Public Const cRunIntervalHours = 0 ' Hours; Range 0 - 23
Public Const cRunIntervalMinutes = 45 ' Minutes; Range 0 - 59
Public Const cRunIntervalSeconds = 0 ' seconds; Range 0 - 59
Public Const cRunWhat = "SaveFile_Timed" ' Place the name of your routine here

'Use Now + TimeValue(time) to schedule something to be run when a specific amount of time
'(counting from now) has elapsed. Use TimeValue(time) to schedule something to be run at
'a specific time.eg TimeValue("21:30") runs it @ 9:30pm

Sub StartTimer()
RunWhen = Now + TimeSerial(cRunIntervalHours, cRunIntervalMinutes, cRunIntervalSeconds)

Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, _
schedule:=True

End Sub

Sub StopTimer()
On Error Resume Next
Application.OnTime earliesttime:=RunWhen, _
procedure:=cRunWhat, schedule:=False
End Sub

Sub SaveFile_Timed()
Dim ThisFile As String, Savedir As String, a

ThisFile = Range("E6").Value
Savedir = "A:\"
On Error GoTo ErrSaving
ActiveWorkbook.SaveCopyAs FileName:=Savedir & ThisFile & ".xls"

'To start over again call routine again
StopTimer
StartTimer

Exit Sub
ErrSaving:
MsgBox "Error#:= " & Err.Number & " = " & Err.Description, vbMsgBoxHelpButton, _
"Error", Err.HelpFile, Err.HelpContext
End Sub

Change as neccesary
eg. to automat this then place code to run Starttimer
in the workbook open event or Auto open

Ivan