ThisWorkbook.Save Issue

[svetovich]

Hi all,

So this is something I've never seen before. I have a number of macros in a workbook that automate the refreshing of ODBC connections and Pivot Tables. There are multiple ThisWorkbook.Save events throughout to track and save the process of the macros. This works great when I run it manually. The issue comes in when I try to schedule it. I have a .vbs file that opens the workbook and runs the automation macro which is automated via a scheduled task. If the scheduled task is set to only run when a user is logged in then it runs perfectly. However, I need this to run when the machine is logged off. When I flag the scheduled task to run whether a user is logged on or not, the process fails. I put in some error trapping in the .vbs file and what I found is that the workbook is erring out on the first ThisWorkbook.Save. The error I'm getting is ...

Error: 1004 : Microsoft Excel cannot access the file 'D:\KAVart\Cart\Base Files\ETM CE Task PIT.xlsm'. There are several possible reasons:

• The file name or path does not exist.
• The file is being used by another program.
• The workbook you are trying to save has the same name as a currently open workbook.

It's almost as if the workbook is being open as ReadOnly and trying to save a copy. Any help here would be greatly appreciated. The .vbs code I'm using is below ...

[FONT=courier new]Option Explicit[/FONT][FONT=courier new]
[/FONT]
[FONT=courier new]Dim xl : Set xl = CreateObject("Excel.Application")[/FONT]
[FONT=courier new]Dim wb : Set wb = Nothing[/FONT]
[FONT=courier new]Dim rp : rp     = "D:\KAVart\Cart\Base Files\ETM CE Task PIT.xlsm"[/FONT]
[FONT=courier new]
[/FONT]
[FONT=courier new]With xl[/FONT]
[FONT=courier new]    On Error Resume Next[/FONT]
[FONT=courier new]    .Workbooks.Open rp, 0, False[/FONT]
[FONT=courier new]    .Run "'" & rp & "'!rpt_Run", True[/FONT]
[FONT=courier new]
[/FONT]
[FONT=courier new]    If Err.Number <> 0 Then[/FONT]
[FONT=courier new]        Dim fso, fil, err_Msg, err_Fol, err_Fil[/FONT]
[FONT=courier new]
[/FONT]
[FONT=courier new]        err_Msg = Err.Number & " : " & Err.Description[/FONT]
[FONT=courier new]        err_Fol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"[/FONT]
[FONT=courier new]        err_Fil = err_Fol & "Error.txt"[/FONT]

[FONT=courier new]        Set fso = CreateObject("Scripting.FileSystemObject")[/FONT]
[FONT=courier new]        Set fil = fso.CreateTextFile(err_Fil, True)[/FONT]
[FONT=courier new]        fil.WriteLine("Error: " & err_Msg)[/FONT]
[FONT=courier new]        fil.Close[/FONT]

[FONT=courier new]        Set fil = Nothing[/FONT]
[FONT=courier new]        Set fso = Nothing[/FONT]
[FONT=courier new]    End If[/FONT]
[FONT=courier new]
[/FONT]
[FONT=courier new]    For Each wb In .Workbooks[/FONT]
[FONT=courier new]        wb.Close False[/FONT]
[FONT=courier new]    Next[/FONT]
[FONT=courier new]
[/FONT]
[FONT=courier new]    .Quit[/FONT]
[FONT=courier new]End WIth[/FONT]
[FONT=courier new]
[/FONT]
[FONT=courier new]Set xl = Nothing[/FONT]
[FONT=courier new]WScript.Quit[/FONT]

 

[svetovich]

I figured out what the issue was. After hours of searching the web I came across this article that answered everything. Creating the folder "C:\Windows\System32\config\systemprofile\Desktop" resolved the error and now my workbook opens and runs without an issue. Thanks for all the help!

 

[mrmmickle1]

svetovich,

Thanks for following up. This is an interesting article. Glad you were able to solve your issue.