CODEWITHSUNDEEP
excelvba
PipEvangelist
PipEvangelist

Reputation: 631

VBA SaveAs to .xlsm does not contain any macro modules

I have a function that basically makes a copy of the current file, and save it to users' "Downloads" folder.

However, while the SaveAs works, the output does not contain any modules. Instead, they are all linked to the exporting file.

Sub PushToProduction()
    Application.ScreenUpdating = False
 
    ' save a copy of current file to the Downloads folder
    outputPath = Environ$("USERPROFILE") & "\Downloads\"
    d = Format(Date, "yyyymmdd")
    fileName = outputPath & "REDACTED " & d & " v1.00.xlsm"
    
   ' prepare to save a copy of the file without the last tab
    sheetCount = Application.Sheets.Count - 1
    Dim tabs() As String
    ReDim tabs(1 To sheetCount)
    For i = 1 To sheetCount
        tabs(i) = Worksheets(i).Name
    Next
    
    Worksheets(tabs).Copy
    
   
    ActiveWorkbook.SaveAs fileName, XlFileFormat.xlOpenXMLWorkbookMacroEnabled
    ActiveWorkbook.Close False
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox ("Success!")
End Sub

The output does not even have the "Modules" folder.

Folders attached to the output

Is there anyway to solve this?

Upvotes: 1

Views: 428

Answers (1)

VBasic2008
VBasic2008

Reputation: 54807

Create a Workbook Copy and Modify It

Option Explicit

Sub PushToProduction()
 
    Dim dFolderPath As String
    dFolderPath = Environ$("USERPROFILE") & "\Downloads\"
    Dim d As String: d = Format(Date, "yyyymmdd")
    Dim dFilePath As String
    dFilePath = dFolderPath & "REDACTED " & d & " v1.00.xlsm"
    
    Application.ScreenUpdating = False
    
    ' Create a reference to the Source Workbook ('swb').
    Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
    ' Save a copy of the Source Workbook.
    If StrComp(dFilePath, swb.FullName, vbTextCompare) = 0 Then
        MsgBox "You are trying save a copy of the file to the same location.", _
            vbCritical, "Push to Production"
        Exit Sub
    End If
    swb.SaveCopyAs dFilePath
    
    ' Open the copy, the Destination Workbook ('dwb'), remove its last sheet
    ' and close saving the changes.
    Dim dwb As Workbook: Set dwb = Workbooks.Open(dFilePath)
    Application.DisplayAlerts = False
    dwb.Sheets(dwb.Sheets.Count).Delete
    Application.DisplayAlerts = True
    dwb.Close SaveChanges:=True
    
    Application.ScreenUpdating = True
    
    ' Inform.
    MsgBox "Success!", vbInformation, "Push to Production"
    
    ' Explore Destination Folder.
    'swb.FollowHyperlink dFolderPath
    
End Sub

Upvotes: 1

Related Questions