ActiveWorkbook.SaveAs to the same file path of worbook

Edgarvelez

Board Regular
Joined
Jun 6, 2019
Messages
81
Office Version
  1. 2016
Platform
  1. Windows
Hi All,

I have this code that works good so foar but I have found 2 changes that I would like to do.

1. It saves to a specific file path and some times i have to move the macro to a different folder or my colleague borrow it and the file path has to changed.
fpath = "\\ACWFSPRDASC01.accessworld.local\FLDRREDIUSA$\Edgar.Velez\Desktop\INTAKE MACRO"
Would like it to save to the same location as the macro

As it saves it opens the file which is fine for final review which is good.

2. When it saves it also checks if the file name alread exists and if it does it pops a message box wich is good
Would like a button on the message box to override the existing file and save this new one.

Below is the full code.


Sub Macro5ExportUpLoadSht()
'
' Macro5ExportUpLoadSht Macro
'

'
Sheets("Intake Macro").Select
Range("A1").Select
Sheets("Intake Macro").Select
Range("A1").Select
Dim fname As String
Dim fpath As String
Dim name As String
Dim ws As Worksheet

'_________________In the line below in between the "" is where you enter the destination folder where the file gets exported to"____________
fpath = "\\ACWFSPRDASC01.accessworld.local\FLDRREDIUSA$\Edgar.Velez\Desktop\INTAKE MACRO"
fname = Range("D13") & " " & Range("D14") & " " & Range("D8") & ".xlsx"
name = Range("D13").Value
On Error Resume Next
Set ws = ThisWorkbook.Sheets("UPLOAD SHEET")
On Error GoTo 0
If ws Is Nothing Then
MsgBox "sheet doesn't exist"
Exit Sub
End If
If Dir(fpath & "\" & fname) = vbNullString Then
ThisWorkbook.Sheets("UPLOAD SHEET").Copy
ActiveWorkbook.SaveAs Filename:=fpath & "\" & fname
Else
MsgBox "STOP!" & Chr(10) & Chr(10) & fname & Chr(10) & "This File Name Already Exists In The Folder" & Chr(10) & Chr(10) & "RENAME OR DELETE THE FILE IN THE FOLDER"
End If
End Sub
 

Some videos you may like

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,502
Office Version
  1. 365
Platform
  1. Windows
For the first item, just change your fpath setting from this:
VBA Code:
fpath = "\\ACWFSPRDASC01.accessworld.local\FLDRREDIUSA$\Edgar.Velez\Desktop\INTAKE MACRO"
to this:
VBA Code:
fpath = ActiveWorkbook.Path

For the second item, maybe something like this would work:
VBA Code:
Dim msg
fname = ActiveWorkbook.Path
If Dir(fpath & "\" & fname) = vbNullString Then
    ThisWorkbook.Sheets("UPLOAD SHEET").Copy
    ActiveWorkbook.SaveAs Filename:=fpath & "\" & fname
Else
    msg = MsgBox("This File Name Already Exists In The Folder" & Chr(10) & Chr(10) & _
            "Click YES to continue to save and overwrite the file" & Chr(10) & _
            "Or NO to to cancel the Save", vbYesNo, "STOP!")
    If msg = vbYes Then
        Application.DisplayAlerts = False
        ThisWorkbook.Sheets("UPLOAD SHEET").Copy
        ActiveWorkbook.SaveAs Filename:=fpath & "\" & fname
        Application.DisplayAlerts = True
    Else
        MsgBox "File save cancelled"
    End If
End If
 

Edgarvelez

Board Regular
Joined
Jun 6, 2019
Messages
81
Office Version
  1. 2016
Platform
  1. Windows
I will give this a try and revert.
Thank you.
 

Edgarvelez

Board Regular
Joined
Jun 6, 2019
Messages
81
Office Version
  1. 2016
Platform
  1. Windows
First item worked great moved the macro to different folders and all is good.
Now my code looks like this

Sheets("Intake Macro").Select
Range("A1").Select
Dim fname As String
Dim fpath As String
Dim name As String
Dim ws As Worksheet
fpath = ActiveWorkbook.Path
fname = Range("D14") & " " & Range("D15") & " " & Range("D8") & ".xlsx"
name = Range("D14").Value
On Error Resume Next
Set ws = ThisWorkbook.Sheets("UPLOAD SHEET")
On Error GoTo 0
If ws Is Nothing Then
MsgBox "sheet doesn't exist"
Exit Sub
End If
If Dir(fpath & "\" & fname) = vbNullString Then
ThisWorkbook.Sheets("UPLOAD SHEET").Copy
ActiveWorkbook.SaveAs Filename:=fpath & "\" & fname
Else
MsgBox "STOP!" & Chr(10) & Chr(10) & fname & Chr(10) & "This File Name Already Exists In The Folder" & Chr(10) & Chr(10) & "RENAME OR DELETE THE FILE IN THE FOLDER"
End If
End Sub

I am unsure where does the second part go, I am very new to VBA and pretty far from your level.
Thanks
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,502
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

It would replace this section:
VBA Code:
If Dir(fpath & "\" & fname) = vbNullString Then
ThisWorkbook.Sheets("UPLOAD SHEET").Copy
ActiveWorkbook.SaveAs Filename:=fpath & "\" & fname
Else
MsgBox "STOP!" & Chr(10) & Chr(10) & fname & Chr(10) & "This File Name Already Exists In The Folder" & Chr(10) & Chr(10) & "RENAME OR DELETE THE FILE IN THE FOLDER"
End If
Note: When posting code, use the "vba" code tags found in the editor menu. It maintains all spacing, your code would look like the code I posted in the last post.
It makes it much easier for us to follow and read.
 

Edgarvelez

Board Regular
Joined
Jun 6, 2019
Messages
81
Office Version
  1. 2016
Platform
  1. Windows
Got a run time 1004 Error
Screen shot below

VBA Code:
    Sheets("Intake Macro").Select
    Range("A1").Select
    Dim fname As String
    Dim fpath As String
    Dim name As String
    Dim ws As Worksheet
    fpath = ActiveWorkbook.Path
    fname = Range("D14") & " " & Range("D15") & " " & Range("D8") & ".xlsx"
    name = Range("D14").Value
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets("UPLOAD SHEET")
    On Error GoTo 0
    If ws Is Nothing Then
    MsgBox "sheet doesn't exist"
    Exit Sub
    End If

Dim msg
fname = ActiveWorkbook.Path
If Dir(fpath & "\" & fname) = vbNullString Then
    ThisWorkbook.Sheets("UPLOAD SHEET").Copy
    ActiveWorkbook.SaveAs Filename:=fpath & "\" & fname
Else
    msg = MsgBox("This File Name Already Exists In The Folder" & Chr(10) & Chr(10) & _
            "Click YES to continue to save and overwrite the file" & Chr(10) & _
            "Or NO to to cancel the Save", vbYesNo, "STOP!")
    If msg = vbYes Then
        Application.DisplayAlerts = False
        ThisWorkbook.Sheets("UPLOAD SHEET").Copy
        ActiveWorkbook.SaveAs Filename:=fpath & "\" & fname
        Application.DisplayAlerts = True
    Else
        MsgBox "File save cancelled"
    End If
End If
End Sub[ATTACH type="full"]14454[/ATTACH]
 

Attachments

  • Error Line.JPG
    Error Line.JPG
    147.4 KB · Views: 4

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,502
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

That is telling you that you probably have an invalid file name.

Add this line before the line highlighted in yellow, run it again, and tell me exactly what it returns to the message box.
VBA Code:
MsgBox fpath & "\" & fname
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
56,502
Office Version
  1. 365
Platform
  1. Windows
Looks like you are doubling up your file path there.
What is in D8, D14, and D15?
Did you actually mean to use the "name" variable there, and not the "fname"?
It looks like "name" just takes the value from D14, while "fname" takes all three.
 

Edgarvelez

Board Regular
Joined
Jun 6, 2019
Messages
81
Office Version
  1. 2016
Platform
  1. Windows
Here is the full code below but let me explain.
What is in D8, D14, and D15?
I am building the export file name
D14 is a job number which is manually entered and every time we do a new job we enter a new number
D15 is a warehouse ref number
D8 is a sort of type mane
all those together in this case equal 005-123456-01 W005-123456 Upld Sht Sunbelt Grp
Kind of building up the name
It can be changed as long as I get the file name based on D8 D14 & D15 then I am fine

I have also included a screen shot of the Intake Macro Sheet


1590164018923.png



VBA Code:
Sub Macro5ExportUpLoadSht()
'
' Macro5ExportUpLoadSht Macro
'

'
    Sheets("Intake Macro").Select
    Range("A1").Select
    Dim fname As String
    Dim fpath As String
    Dim name As String
    Dim ws As Worksheet
    fpath = ActiveWorkbook.Path
    fname = Range("D14") & " " & Range("D15") & " " & Range("D8") & ".xlsx"
    name = Range("D14").Value
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets("UPLOAD SHEET")
    On Error GoTo 0
    If ws Is Nothing Then
    MsgBox "sheet doesn't exist"
    Exit Sub
    End If

Dim msg
fname = ActiveWorkbook.Path
If Dir(fpath & "\" & fname) = vbNullString Then
    ThisWorkbook.Sheets("UPLOAD SHEET").Copy
    MsgBox fpath & "\" & fname
    ActiveWorkbook.SaveAs Filename:=fpath & "\" & fname
Else
    msg = MsgBox("This File Name Already Exists In The Folder" & Chr(10) & Chr(10) & _
            "Click YES to continue to save and overwrite the file" & Chr(10) & _
            "Or NO to to cancel the Save", vbYesNo, "STOP!")
    If msg = vbYes Then
        Application.DisplayAlerts = False
        ThisWorkbook.Sheets("UPLOAD SHEET").Copy
        ActiveWorkbook.SaveAs Filename:=fpath & "\" & fname
        Application.DisplayAlerts = True
    Else
        MsgBox "File save cancelled"
    End If
End If
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,127,035
Messages
5,622,332
Members
415,894
Latest member
silverhaze

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top