VB Code to Open Save and Close xls file

santa12345

Board Regular
Joined
Dec 2, 2020
Messages
70
Office Version
  1. 365
Platform
  1. Windows
hello. i have the following code that is working. the only issue i have is that the template file grows in size and gets too large...as my process loops.
i simply want to add code to open, save and close the template file.
here is the code
--------------------------------------------------------------------------
Private Sub cmd_Monthly_Click()

DoCmd.SetWarnings 0

Dim strWI, strDistrict, strxcel, objFolder, strBO
Dim Temp As Long
Dim ddate As Date
Dim dddate As Integer
Dim datename As String

'Create an FSO for creating needed folders
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Convert the inputed expiration date into the next Month
ddate = CDate(TxtExp)
ddate = ddate + 1
dddate = Month(ddate)
datename = MonthName(dddate)

Dim RetVal

Set objFolder = objFSO.CreateFolder("c:\" & datename)
Set objFolder = objFSO.CreateFolder("c:\" & datename & "\" & "A")
Set objFolder = objFSO.CreateFolder("c:\" & datename & "\" & "B")
Set objFolder = objFSO.CreateFolder("c:\" & datename & "\" & "C")


strxcel = ".xls"
strWI = "A#"


Dim rs As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
Set rs = db.OpenRecordset("Customer", dbOpenTable)

'We've opened the table now go to the first line
rs.MoveFirst

'Keep reading through table until we hit the last entry
'For each record we find, create an ARS excel file
Do Until rs.EOF

txt_agree = rs![customer name]
strDistrict = rs![sales org]

DoCmd.OpenQuery "A - Customer Data", , acReadOnly
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Custdata", "c:\template.xls", True
Sleep (2000)

Set objFolder = objFSO.CreateFolder("c:\" & datename & "\" & strDistrict & "\" & strWI & txt_agree)
RetVal = Shell("cmd /c copy /y c:\template.xls c:\" & datename & "\" & strDistrict & "\" & strWI & txt_agree & "\" & strWI & txt_agree & strxcel, vbHide)

((ADD CODE TO Open up template.xls, save template.xls, close template.xls)) doing so before it loops again seems to work re: the file size


Sleep (2000)
rs.MoveNext

Loop

DoCmd.SetWarnings -1

End Sub
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top