Hi. Need help creating/saving workbooks.

[mrsmith51]

Hello. I need help with something I'm not experienced with in VBA, and have got my botched code in a huge tangle trying to solve.

I need to check whether a specific workbook exists, (create it if it doesn't exist), write a few pieces of data to it, save and close. The workbook will be within a folder of roughly the same name.

The file structure is like this:

\company name\company name week 41.xlsx

Company name is determined by a combobox, week number is determined with a simple formula to calculate the week number of the current date. As each company doesn't visit each week, they won't have a workbook for each week - just for as and when they visit (ex. if they visit on week 40, week 44, week 50, they have workbooks for those weeks, not for the weeks they don't show). This is why it needs to check if the workbook is present and create it first. The folder should already exist for the company, so there is no necessity to check if the folder exists, but I do anyway.

I'll paste my code below

[VBA]Dim myWorkbook As Workbook
Dim wk As String
Application.DisplayAlerts = False
wk = "C:\Users\Dave\Documents\xl\" & CustomerName & "\" & CustomerName & " Week " & WeekNumber & ".xlsx"

'CREATE THE FOLDER
On Error Resume Next
MkDir "C:\Users\Dave\Documents\xl\" & CustomerName
On Error GoTo 0

'Create a new workbook from the template with the week layout
Set myWorkbook = Workbooks.Add(Template:="C:\Users\Dave\Documents\xl\weektemplate.xltx")
myWorkbook.Sheets("sheet1").Range("A5") = "Week " & WeekNumber
myWorkbook.Sheets("sheet1").Range("A6").Select

'Write all the pieces of data into the new week!
PasteDataInCustomerSheet

'Insert a new row underneat when finished, complete with all formulas
InsertRowsAndFillFormulas

'SAVE THE WORKBOOK
Workbooks(wk).Save
Workbooks(wk).Close[/VBA]



What extension should I be using? I settled on .xlsx after trying .xls which didn't work.

I'd appreciate any guidance or help on this, I've done a lot of googling and right now it just seems like a bodge-job I have on my hands. TIA

[Bob Phillips]

Try this

[vba]

Dim myWorkbook As Workbook
Dim path As String
Dim wk As String

Application.DisplayAlerts = False
path = "C:\Users\Dave\Documents\xl"
wk = CustomerName & "\" & CustomerName & " Week " & WeekNumber & ".xlsx"

'CREATE THE FOLDER
On Error Resume Next
MkDir path
Set myWorkbook = Workbooks(wk)
On Error GoTo 0

If myWorkbook Is Nothing Then

'Create a new workbook from the template with the week layout
Set myWorkbook = Workbooks.Add(Template:="C:\Users\Dave\Documents\xl\weektemplate.xltx")
myWorkbook.SaveAs path & "\" & wk
End If

With myWorkbook.Worksheets("sheet1")

.Range("A5") = "Week " & WeekNumber
.Range("A6").Select
End With

'Write all the pieces of data into the new week!
PasteDataInCustomerSheet

'Insert a new row underneat when finished, complete with all formulas
InsertRowsAndFillFormulas

'SAVE THE WORKBOOK
Workbooks(wk).Save
Workbooks(wk).Close
End Sub
[/vba]

[mrsmith51]

Many thanks. I altered the line

[VBA]path = "C:\Users\Dave\Documents\xl" & "\" & CustomerName
[/VBA]

I have a subscript out of range error on the workbooks(wk).save line at the end. What could cause this?

Thanks for your help

[Bob Phillips]

Sorry, I boobed. See if this is better

[VBA]Dim myWorkbook As Workbook
Dim path As String
Dim wk As String

Application.DisplayAlerts = False
path = "C:\Users\Dave\Documents\xl" & CustomerName & "\"
wk = CustomerName & " Week " & WeekNumber & ".xlsx"

'CREATE THE FOLDER
On Error Resume Next
MkDir path
Set myWorkbook = Workbooks.Open(wk)
On Error GoTo 0

If myWorkbook Is Nothing Then

'Create a new workbook from the template with the week layout
Set myWorkbook = Workbooks.Add(Template:="C:\Users\Dave\Documents\xl\weektemplate.xltx")
myWorkbook.SaveAs path & wk
End If

With myWorkbook.Worksheets("sheet1")

.Range("A5") = "Week " & WeekNumber
.Range("A6").Select
End With

'Write all the pieces of data into the new week!
PasteDataInCustomerSheet

'Insert a new row underneat when finished, complete with all formulas
InsertRowsAndFillFormulas

'SAVE THE WORKBOOK
Workbooks(wk).Save
Workbooks(wk).Close[/VBA]

[mrsmith51]

Thanks for your help, this works great!

[mrsmith51]

One last issue I've got all the code together now, however each time it creates a new workbook. How do I provide the Else statement for the [VBA]If myWorkbook Is Nothing Then
[/VBA] line, and get it to go down the other path of just opening the file and writing, rather than the creating the file path?

[VBA]Sub NewWorkbooks()
'This puts all the data into each customer's weekly spreadsheet.
'It creates the folder and file if they do not exist, and amends the file if they do.
Dim myWorkbook As Workbook
Dim path As String
Dim wk As String

Application.DisplayAlerts = False
path = "C:\Users\Dave\Documents\xl" & "\" & CustomerName & "\"
wk = CustomerName & " Week " & WeekNumber & ".xlsx"

'Attempt to create the folder and open the workbook. Upon error, continue
On Error Resume Next
MkDir path
Set myWorkbook = Workbooks.Open(wk)
On Error GoTo 0

'If we cannot open the workbook, it does not exist. Set about creating the workbook and folder...
If myWorkbook Is Nothing Then

'Create a new workbook from the template with the week layout
Set myWorkbook = Workbooks.Add(Template:="C:\Users\Dave\Documents\xl\weektemplate.xltx")
myWorkbook.SaveAs path & wk 'Save the new workbook with the folder path and filename details

'The workbook has been created. Select the appropriate cells to begin writing the data, beginning with the week number
With myWorkbook.Worksheets("sheet1")
.Range("A5") = "Week " & WeekNumber
.Range("A6").Select
End With

'Write all the pieces of data into the new week!
PasteDataInCustomerSheet

'Insert a new row underneat when finished, complete with all formulas
InsertRowsAndFillFormulas

'Save and close the workbook
Workbooks(wk).Save
Workbooks(wk).Close

Else 'The file exists
'Find next empty row by moving to last used cell in column A, then move down 1
Workbooks(wk).Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Select
Workbooks(wk).Worksheets("sheet1").ActiveCell.Offset(1, 0).Select

'Write all the pieces of data into the new week!
PasteDataInCustomerSheet

'Insert a new row underneat when finished, complete with all formulas
InsertRowsAndFillFormulas

'Save and close the workbook
Workbooks(wk).Save
Workbooks(wk).Close

End If

End Sub[/VBA]

[Bob Phillips]

It shouldn't, because that test (as in my original code) should only take effect if it doesn't exist.