Run time error '1004' Cannot access 'Macroed-Upload_Temp.xlsx'

[Steve Belsch]

VBA Experts,

I could use some ideas. I am getting the above message (in the title box). Here is the code. When it gets to the second instance of this code "ActiveWorkbook.SaveAs Filename:=File_Upload_Temp". This is when I get the error. Not sure why it can't access the file, the code just saved it and not it is trying to save it to the same location?

Any thoughts?

Thanks.
Steve

Sub PO_Oracle_Load_Accruals()


Dim ws As Worksheet


'Set Active Workbook name for ease of toggling between sheets
Dim File_Upload As String
File_Upload = ActiveWorkbook.Name


Dim File_Upload_Temp As String
File_Upload_Temp = "Macroed_Upload_Temp"

'Set Sheet names, EmpID, Initials, etc... as variables
Dim Tab1 As String
Dim Tab2 As String
Dim Tab3 As String
Dim EmpID As Long
Dim Initials As String
Dim MonthYear As String


Windows("PO_Accrual_Upload_Macro.xls").Activate
Sheets("Master_Upload").Select


Cells.Find(What:="Tab 1 to Upload", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
Tab1 = ActiveCell.Value


Cells.Find(What:="Tab 2 to Upload", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
Tab2 = ActiveCell.Value


Cells.Find(What:="Tab 3 to Upload", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
Tab3 = ActiveCell.Value


Cells.Find(What:="Employee Number:", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
EmpID = ActiveCell.Value


Cells.Find(What:="Employee Initials:", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
Initials = ActiveCell.Value


Cells.Find(What:="Month & Year:", LookAt:=xlWhole).Activate
ActiveCell.Offset(0, 1).Select
MonthYear = ActiveCell.Value




'Delete all sheets except PD & Functions
Windows(File_Upload).Activate
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> Tab1 And ws.Name <> Tab2 And ws.Name <> Tab3 Then ws.Delete
Next




'Make Note of the Functions/PD Grand Total Accruals
Dim Tab1_Accrual As Long
Dim Tab2_Accrual As Long
Dim Tab3_Accrual As Long
Dim OrigRC As Integer
Dim RawCost As Integer
Dim GrandTotal As Integer


Sheets(Tab1).Select
Cells.Find(What:="Orig Raw Cost", LookAt:=xlWhole).Activate
OrigRC = ActiveCell.Column


Cells.Find(What:="Current Month Cumulative ETD", LookAt:=xlWhole).EntireColumn.Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues


Cells.Find(What:="Raw Cost", LookAt:=xlWhole).EntireColumn.Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
RawCost = ActiveCell.Column


Cells.Find(What:="Grand Total", LookAt:=xlWhole).Activate
GrandTotal = ActiveCell.Column


Tab1_Accrual = ActiveCell.Offset(0, (RawCost - GrandTotal)).Value




If Tab2 <> "None" Then
Sheets(Tab2).Select
Cells.Find(What:="Orig Raw Cost", LookAt:=xlWhole).Activate
OrigRC = ActiveCell.Column


Cells.Find(What:="Current Month Cumulative ETD", LookAt:=xlWhole).EntireColumn.Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues


Cells.Find(What:="Raw Cost", LookAt:=xlWhole).EntireColumn.Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
RawCost = ActiveCell.Column


Cells.Find(What:="Grand Total", LookAt:=xlWhole).Activate
GrandTotal = ActiveCell.Column


Tab2_Accrual = ActiveCell.Offset(0, (RawCost - GrandTotal)).Value


'Put tabs onto one sheet for upload.
Sheets(Tab1).Select
Range("A1").Select
Selection.RemoveSubtotal




ActiveWorkbook.SaveAs Filename:=File_Upload_Temp ...................>>>>>> This is the first instance. it works fine.

Dim Total_Row_Count
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Total_Row_Count = Selection.Rows.Count

Range("A1").Select
For X = 1 To Total_Row_Count
ActiveCell.Offset(1, 0).Select
Next


Sheets(Tab2).Select
Range("A1").Select
Selection.RemoveSubtotal


ActiveWorkbook.SaveAs Filename:=File_Upload_Temp ...................>>>>>> This is the second instance and this is when I get the error message