PDA

View Full Version : [SOLVED] VBA save as function as new workbook



IvanTs8
03-15-2019, 01:13 PM
Hello all,
I have been using this code to save only specific sheet from the workbook. However, I now need to be able to save the entire workbook and save it as macro enabled file .xlsm


Sub MakeFolder()
Dim strVehNum As String, strPathDefault As String, strFolderTestInfo As String
Dim strFolderPics As String, strFolderServiceComments As String
Dim strFolderPrintouts As String, strPath As String, strGroup As String, FSO As New FileSystemObject
Dim fn As String

strVehNum = Range("B1") ' assumes vehicle number in B1
strGroup = Range("B11") ' assumes group in B11
strPath = "G:\03 PROJECTS\AUTOS\"
strFolderTestInfo = "Test info"
strFolderPics = "Pics"
strFolderServiceComments = "Service comments"
strFolderPrintouts = "Printouts"

If Not FSO.FolderExists(strPath & strVehNum & "-" & strGroup) Then
FSO.CreateFolder strPath & strVehNum & "-" & strGroup
FSO.CreateFolder strPath & strVehNum & "-" & strGroup & "\" & strFolderTestInfo
FSO.CreateFolder strPath & strVehNum & "-" & strGroup & "\" & strFolderPics
FSO.CreateFolder strPath & strVehNum & "-" & strGroup & "\" & strFolderServiceComments
FSO.CreateFolder strPath & strVehNum & "-" & strGroup & "\" & strFolderPrintouts
End If

fn = strPath & strVehNum & "-" & strGroup & "\" & strFolderTestInfo & "\TP " & strVehNum & ".xls"
If Dir(fn) <> "" Then Exit Sub


With Workbooks.Add(xlWBATWorksheet)
ThisWorkbook.Worksheets("Test Plan").Copy after:=.Sheets(1)
Application.DisplayAlerts = False
.Sheets(1).Delete
Application.DisplayAlerts = True
On Error Resume Next
Kill fn
.SaveAs fn, xlExcel8
.Close False
End With
End Sub

大灰狼1976
03-18-2019, 01:08 AM
Hi IvanTs8!
Not sure, but you can try it:
change
.SaveAs fn, xlExcel8
into
.SaveAs fn, xlOpenXMLWorkbookMacroEnabled

大灰狼1976
03-18-2019, 01:12 AM
and this line:
fn = strPath & strVehNum & "-" & strGroup & "" & strFolderTestInfo & "\TP " & strVehNum & ".xlsm"

snb
03-18-2019, 04:58 AM
This code is sufficient:


Sub M_snb()
c00 = "03_PROJECTS\AUTOS\" & [B1] & "_" & [B11] & "\Test_Info\Pics\Service_comments\Printouts"
c01 = "\TP_" & [B11] & ".xlsb"
If Dir("G:\" & c00, 16) = "" Then CreateObject("shell.application").Namespace("G:").NewFolder c00

If Dir("G:\" & c00 & c01) = "" Then ThisWorkbook.SaveAs "G:\" & c00 & c01, 50
End Sub

IvanTs8
03-18-2019, 02:05 PM
Hi IvanTs8!
Not sure, but you can try it:
change
.SaveAs fn, xlExcel8
into
.SaveAs fn, xlOpenXMLWorkbookMacroEnabled

Thanks! that worked to save the file as Macro Enabled file! I also added an array with the sheets i need copied and saved.
Works great now!


With Workbooks.Add(xlWBATWorksheet)
ThisWorkbook.Sheets(Array("RTA", "Fahrzeugliste")).Copy after:=.Sheets(1)
Application.DisplayAlerts = False
.Sheets(1).Delete
Application.DisplayAlerts = True
On Error Resume Next
Kill fn
.SaveAs fn, xlOpenXMLWorkbookMacroEnabled
.Close False
End With
End Sub

大灰狼1976
03-18-2019, 06:07 PM
You're welcome :friends: