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
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