View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
NoodNutt NoodNutt is offline
external usenet poster
 
Posts: 221
Default Problem saving file to My Documents


G'day John

Try this code instead, it Compiled OK, so it should be alright.

Sub SaveMyFile()

Dim MyCurWB As Workbook
Dim MyCopyWB As Workbook
Dim FilePath As String
Dim NewFileName As String
Dim FileExtStr As String

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set MyCurWB = ActiveWorkbook

With MyCurWB
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
If MyCurWB.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

FilePath = "C:\My Documents" 'Use this for local drive
'OR
FilePath = "\\YourNetworkFolder1\My Documents" 'Use if over network -
disregard the underlining

NewFileName = MyCurWB.Name & " " & Format(Now, "dd-mmm-yy h-mm AM/PM")
FileExtStr = "." & LCase(Right(MyCurWB.Name, Len(MyCurWB.Name) -
InStrRev(MyCurWB.Name, ".", , 1)))

MyCurWB.SaveCopyAs FilePath & NewFileName & FileExtStr
Set MyCopyWB = Workbooks.Open(FilePath & NewFileName & FileExtStr)


With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

HTH
Mark.