PDA

View Full Version : Save Question



Emoncada
12-26-2007, 07:35 PM
I have this code that works great
Public FilePath As String
Sub SaveAs()
Dim strSaveAsFile As String, fp As String

FilePath = ""
' Change the FilePath to suit
fp = "C:\Depot Outgoing\"
Call MakeFolders(fp)
Call MakeFolders(Format(Date, "yyyy") & "\")
Call MakeFolders(Format(Date, "mmmm yyyy") & "\")
Call MakeFolders(Format(Date, "mmm dd") & "\")

strSaveAsFile = "Pim " & (Format(Date, "mm.dd.yy")) & " AC" & ".xls"

ActiveWorkbook.SaveAs FilePath & strSaveAsFile, xlWorkbookNormal
FilePath = ""

End Sub

Private Sub MakeFolders(fp As String)
FilePath = FilePath & fp
If Dir(FilePath, vbDirectory) = "" Then MkDir FilePath
End Sub

I want it to run when a cmdbutton is clicked and cell value a2 is empty.

Then have the spreadsheet save itself every 10 minutes. Can this be done?

anandbohra
12-27-2007, 12:02 AM
now this code works only when cell a2 is empty

Private Sub CommandButton1_Click()
If Sheet1.Range("a2").FormulaR1C1 = "" Then
Call Saveas 'The name of your module to be run if value is not there
Else
MsgBox "Value is there" ' Custom message if value found
End If
End Sub



Now to run autosave every 10 minutes use this code (courtesy of XLD as he gaves me this code earlier in this site; now customized by me for your purpose)

put this code in module

Option Explicit
Public nTime As Double
Sub refresh()
Application.save
nTime = Now + TimeSerial(0, 10, 0) ' change to suit
Application.OnTime nTime, "refresh"
End Sub



put this code in 'Thisworkbook' code

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnTime nTime, "refresh", , False
End Sub

Private Sub Workbook_Open()
Call refresh
End Sub

Bob Phillips
12-27-2007, 02:33 AM
As an aside,

here is a routine that will create directories bottom up, saving all of those calls



Function CreateDirs(ByVal Path As String)
Dim mpDirs As Variant
Dim mpPart As String
Dim i As Long
mpDirs = Split(Path, Application.PathSeparator)

mpPart = mpDirs(LBound(mpDirs))
For i = LBound(mpDirs) + 1 To UBound(mpDirs)

mpPart = mpPart & Application.PathSeparator & mpDirs(i)
On Error Resume Next
MkDir mpPart
On Error GoTo 0
Next i
End Function


and use it like so



CreateDirs "C:\Depot Outgoing\"& _
Format(Date, "yyyy") & "\" & _
Format(Date, "mmmm yyyy") & "\" & _
Format(Date, "mmm dd") & "\"