Create folder and workbook inside

[Ingolf]

Hello,

I need help with some VBA cod to make folder with the name found in cell A2 and in that folder make workbook with the name find in cell B2.
It's possible?

 

[GTO]

Hi there,

Please note that this does not check for lacking values and/or illegal characters. I would check for both.

Option Explicit
    
Sub exa1()
Dim wb As Workbook
    
    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(ThisWorkbook.Path & "\" & Sheet2.Range("A2").Text) Then
            .CreateFolder (ThisWorkbook.Path & "\" & Sheet2.Range("A2").Text)
            Set wb = Workbooks.Add
            wb.SaveAs ThisWorkbook.Path & "\" & Sheet2.Range("A2").Text & "\" & Sheet2.Range("B2").Text
            wb.Close False
        End If
    End With
End Sub

 

[Ingolf]

Thanks for replay. It return "Compile error variable not defined"
Can you help me?

 

[GTO]

I am guessing that you may have not changed the CodeName correctly?

In the bits like: Sheet2.Range("A2").Text)

'Sheet2' is not referring to the sheet by the name on the tab, but by the sheet's CodeName. That is why there are no quote marks around it.

On the sheet you have the folder and file name listed, right-click the tab and select View Code. In VBIDE, look at the properties window and the first property: '(Name)' is the sheet's codename.

Does that help?

Mark

 

[Ingolf]

I'm afraid I not understand cause I'm novice in VBA. Anyway I copy and pasted the cod in a module an run but I get same result:
"Compile error
variable not defined"
Tell me what I can do.

 

[GTO]

Okay, what is the name of the worksheet that has the folder name in A2 and the filename in B2?

What named are you trying to use for the folder? That is, what do you currently have in A2?

What name are you trying to use for the new workbook (in B2)?

Mark

 

[Ingolf]

Name of worksheet is TEMPLATE. (I try also with sheet1, sheet2...). In A2 could be text or number. Also in B2 could be text or number so name of workbook would be text or number.
Thank you very mach for yor time spend with me.

 

[GTO]

Try:

Option Explicit
    
Sub exa2()
Dim FSO         As Object
Dim wb          As Workbook
Dim wks         As Worksheet
Dim strFileName As String
    
Const SH_NAME As String = "TEMPLATE"    '<--Change to suit
    
    '// Check to ensure the sheet exists                                            //
    On Error Resume Next
    Set wks = ThisWorkbook.Worksheets(SH_NAME)
    On Error GoTo 0
    
    If wks Is Nothing Then
        MsgBox SH_NAME & " is missing!", 0, vbNullString
        Exit Sub
    End If
    
    '// Ensure both suggested filename and foldername are legal                     //
    If Not (IsLegalNam(wks.Range("A2").Value) And IsLegalNam(wks.Range("B2").Value)) Then
        MsgBox "On of the suggested names is illegal", vbExclamation, vbNullString
        Exit Sub
    End If
    
    strFileName = wks.Range("B2").Value
    
    '// Change to suit                                                              //
    If Not Right(strFileName, 4) = ".xls" Then
        strFileName = strFileName & ".xls"
    End If
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    With FSO
        If Not .FolderExists(ThisWorkbook.Path & "\" & wks.Range("A2").Text) Then
            .CreateFolder (ThisWorkbook.Path & "\" & wks.Range("A2").Text)
            Set wb = Workbooks.Add
            wb.SaveAs ThisWorkbook.Path & "\" & wks.Range("A2").Text & "\" & wks.Range("B2").Text
            wb.Close False
        End If
    End With
End Sub
    
Function IsLegalNam(NameInputted As String, Optional IsFileName As Boolean = True) As Boolean
Dim IllegalCharacters As Variant
Dim i As Long
    
    IsLegalNam = True
    IllegalCharacters = IIf(IsFileName, _
                                Array("/", "\", ":", "*", "?", """", "<", ">", "|", "!"), _
                                Array(":", "/", "\", "?", "*", "[", "]", "!") _
                            )
                            
    For i = LBound(IllegalCharacters) To UBound(IllegalCharacters)
        If CBool(InStr(1, NameInputted, IllegalCharacters(i))) Then
            IsLegalNam = False
            Exit Function
        End If
    Next
    
    If Not IsFileName And (Len(NameInputted) > 31 Or UCase(NameInputted) = "HISTORY") Then
        IsLegalNam = False
    End If
End Function

 

[Ingolf]

Wow, EXCELENT it work like a charm. Thank you very much.
Now if you can tell me how I can copy date between column E and AZ and paste special in file new created. Thank you

 

[Ingolf]

Wow, EXCELENT it work like a charm. Thank you very much.
Now if you can tell me how I can copy date between column E and AZ and paste special in file new created. Thank you

Now if you can tell me how I can copy date from "TEMPLATE" between column E and AZ and paste special in file new created. Thank you