PDA

View Full Version : Hi. Need help creating/saving workbooks.



mrsmith51
12-15-2010, 08:43 AM
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

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



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
12-15-2010, 09:24 AM
Try this



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

mrsmith51
12-15-2010, 09:37 AM
Many thanks. I altered the line

path = "C:\Users\Dave\Documents\xl" & "\" & CustomerName


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
12-15-2010, 10:12 AM
Sorry, I boobed. See if this is better

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

mrsmith51
12-15-2010, 10:40 AM
Thanks for your help, this works great!

mrsmith51
12-15-2010, 12:01 PM
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 If myWorkbook Is Nothing Then
line, and get it to go down the other path of just opening the file and writing, rather than the creating the file path?

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

Bob Phillips
12-15-2010, 12:49 PM
It shouldn't, because that test (as in my original code) should only take effect if it doesn't exist.