Can anyone assist on a macro error

[ghrek]

I have the following macro and keep getting Run time error 75 path/file access error on the following line

MkDir SaveAsPath ''/// creates a new folder in the active folder

in the area called summary where I have put macro it is not in a folder but its a file on its own within drive.

Any ideas?

Option Explicit


Sub SaveASFile()
Dim oWb As Workbook
Dim Ans As String
Dim fileName As String, SaveAsPath As String, SourceFldr As String, Fldr As String, sFil As String
Dim aLinks As Variant
Dim Ctr As Long

SaveAsPath = "T:\Passenger\Excel\passacc\backup"

Ans = MsgBox("Do you want to Save A Copy?", vbQuestion + vbYesNo, "Confirm Please!")
If Ans = vbYes Then
Application.DisplayAlerts = False
fileName = ThisWorkbook.Name & Format(Date, "dd mm yyyy") & ".xlsx"
''///51 is for Open XML Workbook (*.xlsx)
''///52 is for Open XML Workbook With Macros Enabled (*.xlsm)
MkDir SaveAsPath ''/// creates a new folder in the active folder
ChDir SaveAsPath ''/// change directory
ThisWorkbook.SaveAs SaveAsPath & fileName, 51
aLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)

If IsArray(aLinks) Then
For Ctr = LBound(aLinks) To UBound(aLinks)
ActiveWorkbook.BreakLink Name:=aLinks(Ctr), _
Type:=xlLinkTypeExcelLinks
Next Ctr
End If

SourceFldr = "T:\Passenger\NEW INPUT SCREENS"

Fldr = Application.InputBox("Enter title for new folder", "Create Subfolder")
If Len(Fldr) = 0 Then
MsgBox "Nothing Entered"
Exit Sub
Else
SaveAsPath = SaveAsPath & Application.PathSeparator & Fldr
End If

MkDir SaveAsPath ''/// creates a new folder in the active folder
ChDir SourceFldr ''/// change directory

sFil = Dir("*.xlsx") 'change or add formats
Do While sFil <> "" ''///will start LOOP until all files in folder sPath have been looped through
Workbooks.Open (SourceFldr & Application.PathSeparator & sFil) ''///opens the file
oWb.SaveAs SaveAsPath & fileName, 51
oWb.Close False
Loop
Application.DisplayAlerts = True
Else: Exit Sub
End If
End Sub

 

[Rick Rothstein]

The MkDir statement can only make a sub directory if all of the higher sub directories already exist. So, for these lines of code...

SaveAsPath = "T:\Passenger\Excel\passacc\backup"
MkDir SaveAsPath ''/// creates a new folder in the active folder
ChDir SaveAsPath ''/// change directory

It is hard to know your existing structure, but this path must already exist...

"T:\Passenger\Excel\passacc"

and since you are not specifying it directly in the MkDir statement, then you must already be in that directory prior to executing the MkDir statement. I don't see a ChDir statement doing that in your current code... are you doing it in subroutine that is called prior to running the SaveAsFile subroutine that you posted?

 

[ghrek]

Many thanks but that is above my head as im a complete novice and I inherited the macro from another person and I think it too complicated.

I have files located in

"T:\Passenger\Excel\passacc\shere"
"T:\Passenger\Excel\passacc\cubic"
"T:\Passenger\Excel\passacc\fastis
"T:\Passenger\Excel\passacc\summary
and a folder called ""T:\Passenger\NEW INPUT SCREENS"


and what im trying to do is move them into a sub folder within T:\Passenger\Excel\passacc\backup"

In the file called summary I have it linked to the files called "NEW INPUT SCREENS" and I need to break the link when saving as the original input screens and summary will have data deleted to start using again.

What I need to do first before I move them is to create the new sub folder and ask me to name the folder

Is there an easier way I can do that?