Code:
1. Private Sub Command1_Click()
2. 'Requires reference: Microsoft Excel (version) Object Library
3. Dim XLapp As New Excel.Application
4. XLapp.Visible = True
5. Dim wbkReport As Excel.Workbook
6. Dim wbkTemplate As Excel.Workbook
7. Dim wksReport As Excel.Worksheet
8. Dim wksTemplate As Excel.Worksheet
9.
10. Dim sOpenFileName As String, sSaveAsFileName As String, iSheet As Integer, irange As Integer, i As Integer
11.
12.
13. 'Set path to template file here
14. sOpenFileName = App.Path & "\" & "root\Root.xls"
15.
16. 'Set your path to save file here:
17. sSaveAsFileName = App.Path & "\" & "Arhiva - " & Replace(Date, "/", "-") & ".xls"
18.
19. 'Open template
20. Set wbkTemplate = XLapp.Workbooks.Open(sOpenFileName)
21.
22. 'Suppress Excel warnings
23. XLapp.DisplayAlerts = False
24.
25. If Dir(sSaveAsFileName) <> "" Then
26. 'if a report from today exists, reset use it as the template
27. Set wbkReport = XLapp.Workbooks.Open(sSaveAsFileName)
28. Set wksTemplate = wbkTemplate.Sheets(1)
29.
30.
31. 'wksTemplate.Copy after:=wbkReport.Sheets(wbkReport.Sheets.Count)
32. 'Set wksReport = wbkReport.Sheets(wbkReport.Sheets.Count)
33.
34.
35. wbkTemplate.Close SaveChanges:=False
36. Else
37. 'This is the first report of the day
38. Set wbkReport = wbkTemplate
39. 'Set reference to first sheet in workbook
40. Set wksReport = wbkReport.Sheets(1)
41. 'Delete extra sheets from template
42. If wbkReport.Sheets.Count > 1 Then
43. 'Start deleting extra sheets (only in this 'copy' of the template)
44. 'if they exist, starting from last sheet
45. For iSheet = wbkReport.Sheets.Count To 2 Step -1
46. If wbkReport.Sheets(iSheet).Name = "Sheet" & iSheet Then wbkReport.Sheets(iSheet).Delete
47. Next 'iSheet
48. End If
49. End If
50.
51. 'Set report sheet name based on form name (duplicate names not allowed...)
52.
53.
54. 'Copy text fields
55. wksReport.Range("A2") = Text1.Text
56. wksReport.Range("B2") = Text2.Text
57.
58.
59. 'Save workbook as whatever is in "sSaveAsFileName" variable
60. wbkReport.SaveAs FileName:= _
61. sSaveAsFileName, FileFormat:= _
62. xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
63. , CreateBackup:=False
64.
65. 'Close workbook
66. wbkReport.Close SaveChanges:=False
67.
68. 'Allow Excel warnings
69. XLapp.DisplayAlerts = True
70.
71. 'Remove references to sheets/workbooks before quitting (was hanging a second on wksreport if Excel was closed already)
72. Set wksReport = Nothing
73. Set wbkReport = Nothing
74. Set wksTemplate = Nothing
75. Set wbkTemplate = Nothing
76.
77. 'Close Excel
78. XLapp.Quit
79.
80. 'Remove final reference
81. Set XLapp = Nothing
82.
83. End Sub
Comment