ActiveWorkbook.SaveAs to the same file path of worbook

[Edgarvelez]

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

 

[Joe4]

For the first item, just change your fpath setting from this:

fpath = "\\ACWFSPRDASC01.accessworld.local\FLDRREDIUSA$\Edgar.Velez\Desktop\INTAKE MACRO"

to this:

fpath = ActiveWorkbook.Path

For the second item, maybe something like this would work:

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]

I will give this a try and revert.
Thank you.

 

[Edgarvelez]

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]

It would replace this section:

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]

Got a run time 1004 Error
Screen shot below

    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]

 

[Joe4]

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.

MsgBox fpath & "\" & fname

 

[Edgarvelez]

 

[Joe4]

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]

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

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