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.
|