PDA

View Full Version : Solved: Save As Open help



Emoncada
02-15-2008, 06:31 AM
I have this script that when a user clickes a button on the spreadsheet it checks the value of A2 if empty it calls a form that prompts for your initials then saves it as "Pim " & (Format(Date, "mm.dd.yy ")) & res & .xls"

res = input of the initials.

Now My question is I need for when the user enters his/her initials instead of saving it have it look to see if it's already there and if so have it open it instead of it asking the user whether they wish to replace the original. If it's not found then save it the usual way.

Can this be done.

Bob Phillips
02-15-2008, 06:46 AM
Untested.



On Error Resume Next
Set wb = Workbooks.Open("Pim" & Format(Date, "mm.dd.yy ") & res & .xls")
On Error Goto 0

If wb Is Nothing Then
Set wb = Activeworkbook
wb.SaveAs "Pim" & Format(Date, "mm.dd.yy ") & res & .xls"
End If

Emoncada
02-15-2008, 07:33 AM
Now this is the code I got where would I put that.

Option Explicit
Sub Button1_Click()
If Sheet2.Range("a2").FormulaR1C1 = "" Then
Call SaveAs 'The name of your module to be run if value is not there
Else
UserForm1.Show
Exit Sub
End If
UserForm1.Show
End Sub

And the Save As code

Public FilePath As String
Sub SaveAs()
Dim strSaveAsFile As String, fp As String
Dim res As String
FilePath = ""
' Change the FilePath to suit
'fp = "C:\Depot Outgoing 2008\"
fp = "S:\Depot Outgoing 2008\"
Call MakeFolders(fp)
Call MakeFolders(Format(Date, "yyyy") & "\")
Call MakeFolders(Format(Date, "mmmm yyyy") & "\")
Call MakeFolders(Format(Date, "mmm dd") & "\")

res = InputBox("What Are Your Initials", "Save Your PS Pim")
strSaveAsFile = "Pim " & (Format(Date, "mm.dd.yy ")) & res & ".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

Bob Phillips
02-15-2008, 08:07 AM
Sub SaveAs()
Dim strSaveAsFile As String, fp As String
Dim res As String
Dim wb As Workbook

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

res = InputBox("What Are Your Initials", "Save Your PS Pim")
strSaveAsFile = "Pim " & (Format(Date, "mm.dd.yy ")) & res & ".xls"
On Error Resume Next
Set wb = Workbooks.Open(strsavefile)
On Error GoTo 0
If wb Is Nothing Then
Set wb = ActiveWorkbook
wb.SaveAs FilePath & strSaveAsFile, xlWorkbookNormal
End If

End Sub
Private Sub MakeFolders(fp As String)
Dim Dirs As Variant
Dim tmpDir As String
Dim i As Long

Dirs = Split(fp, "\")
tmpDir = Dirs(0) & Application.PathSeparator
On Error Resume Next
For i = LBound(Dirs) + 1 To UBound(Dirs)

tmpDir = tmpDir & Dirs(i) & Application.PathSeparator
MkDir tmpDir
Next i
End Sub

Emoncada
02-15-2008, 08:29 AM
xld that still gives me the file name already exists do i want to replace it. Is there a way to have it look first if it exists then open if so else save as.

Bob Phillips
02-15-2008, 08:59 AM
I think a typo in the code didn't help



Sub SaveAs()
Dim strFilepath As String
Dim strSaveAsFile As String, fp As String
Dim res As String
Dim wb As Workbook

strFilepath = "C:\Depot Outgoing 2008\" & _
Format(Date, "yyyy") & "\" & _
Format(Date, "mmmm yyyy") & "\" & _
Format(Date, "mmm dd") & "\"
Call MakeFolders(strFilepath)

res = InputBox("What Are Your Initials", "Save Your PS Pim")
strSaveAsFile = "Pim " & (Format(Date, "mm.dd.yy ")) & res & ".xls"
On Error Resume Next
Set wb = Workbooks.Open(strFilepath & strSaveAsFile)
On Error GoTo 0
If wb Is Nothing Then
Set wb = ActiveWorkbook
wb.SaveAs strFilepath & strSaveAsFile, xlWorkbookNormal
End If

End Sub

Private Sub MakeFolders(fp As String)
Dim Dirs As Variant
Dim tmpDir As String
Dim i As Long

Dirs = Split(fp, "\")
tmpDir = Dirs(0) & Application.PathSeparator
On Error Resume Next
For i = LBound(Dirs) + 1 To UBound(Dirs)

tmpDir = tmpDir & Dirs(i) & Application.PathSeparator
MkDir tmpDir
Next i
End Sub

Emoncada
02-15-2008, 09:20 AM
xld that seems to work but for some reason it doesn't want to connect to the shared drive and save's the file in My Documents Folder. It's not making the folders


Format(Date, "yyyy") & "\" & _
Format(Date, "mmmm yyyy") & "\" & _
Format(Date, "mmm dd") & "\"


Any ideas?

Bob Phillips
02-15-2008, 09:23 AM
I changed your S drive to C in my tests, I don't have an S. Reset it.

Emoncada
02-15-2008, 09:32 AM
OK I fixed it xld thanks for the code works great.

Emoncada
02-15-2008, 09:33 AM
instead of S: i put the actuall server name \\servername\shared (file://\\servername\shared) and worked perfectly thanks.