Create a folder on a users desktop and then save the file as xlsx not xlsm (Remove macros)

TkdKidSnake

Board Regular
Joined
Nov 27, 2012
Messages
243
Office Version
  1. 365
Platform
  1. Windows
Hi all,

Can you help me, I am trying to create a folder called "JJS Submission Docs" on a users desktop however the use is not defined and then save the particular file in this folder as an xlsx file instead of the original xlsm as I do not want the macros in the newly saved version. What I have so far is below but unfortunately it doesn't work:

VBA Code:
Sub SaveToDeskTop()

Application.DisplayAlerts = False

Dim usrnme As String
Dim myFolderName As String
Dim myFileName As String

'Get username
usrnme = Environ("username")

Sheets("Level 3 PPAP Requirements").Select

    ActiveSheet.Unprotect
    
    Range("G4").Select
    Selection.Copy
    Range("I1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G6").Select
    
'   Build folder name with today's date
    myFolderName = Environ("username") & "\JJS Submission Docs\"

'   Check to see if folder name exists already.  If not, create it
    If (Dir(myFolderName, vbDirectory)) = "" Then MkDir myFolderName

'   Build file name - the filename is in cell i1 on tab Level 3 PPAP Requirements"
    myFileName = Range("i1") & ".xlsx"
    
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False

Sheets("1. PSW").Select

'   Save file
    ActiveWorkbook.SaveAs Filename:=myFolderName & "\" & myFileName, _
        FileFormat:=51, CreateBackup:=False

Application.DisplayAlerts = True

End Sub


If anyone can help me with this it would be greatly appreciated.

Many thanks.
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
73,436
Office Version
  1. 365
Platform
  1. Windows
Try
VBA Code:
myFolderName = Environ("userprofile") & "\Desktop\JJS Submission Docs\"
 

TkdKidSnake

Board Regular
Joined
Nov 27, 2012
Messages
243
Office Version
  1. 365
Platform
  1. Windows
Try
VBA Code:
myFolderName = Environ("userprofile") & "\Desktop\JJS Submission Docs\"

Many thanks for this it then jump to another error but that was pretty simple to solve as it was the folder location with filename had an - & "\" -
and it didn't need it.

Code used is below for reference:

VBA Code:
Sub SaveToDeskTop()

Application.DisplayAlerts = False

Dim usrnme As String

'Get username
usrnme = Environ("username")

Sheets("Level 3 PPAP Requirements").Select

    ActiveSheet.Unprotect
    
    Range("G4").Select
    Selection.Copy
    Range("I1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G6").Select
    
Dim myFolderName As String
    Dim myFileName As String
    
'   Build folder name with today's date
    myFolderName = Environ("userprofile") & "\Desktop\JJS Submission Docs\"


'   Check to see if folder name exists already.  If not, create it
    If (Dir(myFolderName, vbDirectory)) = "" Then MkDir myFolderName


'   Build file name
    myFileName = Range("i1") & ".xlsx"
    

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False

Sheets("1. PSW").Select

'   Save file
    ActiveWorkbook.SaveAs Filename:=myFolderName & myFileName, _
        FileFormat:=51, CreateBackup:=False
Dim FileName1 As String


Application.DisplayAlerts = True


End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
73,436
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,632
Messages
5,838,470
Members
430,549
Latest member
jayjay2022

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