Permission denied - Run time error 70

[TG2812]

Hello,

I'm trying to duplicate and save my active workbook but for some reasons, the following error is popping up during the macro execution;
"Permission denied - Run time error 70". I tried to browse around but i still cannot find where I made the mistake in the coding.

Any help would be much appreciated.



Application.CutCopyMode = True
Application.ScreenUpdating = False


Dim newname As String
Dim i As Integer
Set Obj = CreateObject("WScript.Shell")
desktop = Obj.SpecialFolders("Desktop")
current = ActiveWorkbook.Path


newname = "myname1 " & " - " & Environ("UserName") & " - " & Replace(Now(), "/", "-")
FileCopy current & "" & ActiveWorkbook.name, desktop & "" & newname & ".xlsm"

 

[TG2812]

The message box returns a type mismatch error (type mismatch).
If you have a different way for doing the following step (another VBA code), please feel free to suggest something different;

1. copy the active workbook
2. check if there is the same existing workbook in the path

Thank you.

 

[Yongle]

Oops
- try this for the message box and see what it returns

MsgBox current & Chr(92) & ActiveWorkbook.Name & vbCr & desktop & Chr(92) & newname & ".xlsm"

 

[TG2812]

This is what the msgbox returns

C:\Users\xxxxx\Desktop\myfilename.xlsm
C:\Users\xxxxx\Desktop\myfilename – xxxxx – 12-8-2018 8-00-37 PM.xlsm

 

[Yongle]

C:\Users\xxxxx\Desktop\myfilename – xxxxx – 12-8-2018 8-00-37 PM.xlsm
Is a valid filename (assuming XXXXX are all alpha characters)


What happens when you try to save the file manually (with name= "myfilename – xxxxx – 12-8-2018 8-00-37 PM.xlsm") to that same location?

 

[TG2812]

When i do save this file and replicate it on my desktop it works.
XXXXX comprises only alphacharacters .

 

[Yongle]

Try

[COLOR=#000000][FONT=Consolas]ActiveWorkbook.SaveCopyAs [/FONT][/COLOR]

followed by a space and the above full Name & Path string

offline now until tomorrow

 

[TG2812]

Unfortunately, I have not make any progress and the macro bugs and returns the error 70 - permission denied.
Herebelow is the full macro. Any help would be really appreciated.



Sub mymacro()


Application.CutCopyMode = True
Application.ScreenUpdating = False


Dim newname As String
Dim i As Integer
Set Obj = CreateObject("WScript.Shell")
desktop = Obj.SpecialFolders("Desktop")
current = ActiveWorkbook.Path
newname = "My File Extract " & " - " & Environ("UserName") & " - " & Replace(Replace(Now(), "/", "-"), ":", "-")


FileCopy ActiveWorkbook.Path & "" & ActiveWorkbook.name, desktop & "" & newname & ".xlsm"


check = Now()
While Now() < check + 2 / (24 * 60 * 60)
Wend


Workbooks.Open desktop & "" & newname & ".xlsm"


Sheets("Sheet1").Visible = xlVeryHidden
Sheets("Sheet2").Visible = xlVeryHidden
Sheets("Sheet3").Visible = xlVeryHidden
Sheets("Sheet5").Visible = xlVeryHidden
ActiveWorkbook.Save
ActiveWorkbook.Close False
MsgBox "New file created :" & Chr(10)


End Sub

 

[rlv01]

Perhaps this:

Sub mymacro()
    Dim Obj As Object
    Dim desktop, current
    Dim DestFile As String
    Dim SrcWB As Workbook, DestWB As Workbook
    Dim WS As Worksheet
    Dim newname As String

    Application.ScreenUpdating = False

    Set SrcWB = ThisWorkbook
    Set Obj = CreateObject("WScript.Shell")
    
    desktop = Obj.SpecialFolders("Desktop")
    current = SrcWB.Path
    newname = "My File Extract " & " - " & Environ("UserName") & " - " & Replace(Replace(Now(), "/", "-"), ":", "-")
    DestFile = desktop & "\" & newname & ".xlsm"

    SrcWB.SaveCopyAs DestFile

    Application.Wait (Now + TimeValue("0:00:02"))

    Set DestWB = Workbooks.Open(DestFile)
    With DestWB
        For Each WS In .Worksheets
            Select Case WS.Name
            Case "Sheet1", "Sheet2", "Sheet3", "Sheet5"
                WS.Visible = xlSheetVeryHidden
            End Select
        Next WS
        .Save
        .Close False
    End With
    Application.ScreenUpdating = True
    MsgBox "New file created :" & Chr(10)
End Sub

 

[TG2812]

Thank you very much. It works!

However, when the code gets to the section "SrcWB.SaveCopyAs DestFile", the macro execution gets slower as it needs to re-calculate all UDF..Any improvement ideas?

 

[rlv01]

Sub mymacro()
    Dim Obj As Object
    Dim desktop
    Dim DestFile As String
    Dim SrcWB As Workbook
    Dim WS As Worksheet
    Dim newname As String

    Application.ScreenUpdating = False

    Set SrcWB = ThisWorkbook
    Set Obj = CreateObject("WScript.Shell")

    desktop = Obj.SpecialFolders("Desktop")
    newname = "My File Extract " & " - " & Environ("UserName") & " - " & Replace(Replace(Now(), "/", "-"), ":", "-")
    DestFile = desktop & "\" & newname & ".xlsm"

    With SrcWB
        For Each WS In .Worksheets
            Select Case WS.Name
            Case "Sheet1", "Sheet2", "Sheet3", "Sheet5"
                WS.Visible = xlSheetVeryHidden
            End Select
        Next WS
    End With

    SrcWB.SaveCopyAs DestFile

    With SrcWB
        For Each WS In .Worksheets
            Select Case WS.Name
            Case "Sheet1", "Sheet2", "Sheet3", "Sheet5"
                WS.Visible = xlSheetVisible
            End Select
        Next WS
    End With

    Application.ScreenUpdating = True
    MsgBox "New file created :" & vbCr & vbCr & newname
End Sub