santa12345
Board Regular
- Joined
- Dec 2, 2020
- Messages
- 66
- Office Version
- 365
- Platform
- 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
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