saving an excel file

[MJD1]

Hi, I have a query that I populates an excel template which is then attached to an email. the code that i peiced together from doing some research works very well. The only thing is that I would like the excel template to save itself autoomatically. the way it currently works is that the user must select Yes when prompted to save the template. if the user selects no, then the template that attaches to the email is blank.

I'm hoping someone can help me figure this simple problem out.
As you can see below, I tried "y.save" which prompts me to save some other unrelated template.

heres my code:

Private Sub cmdExportAutomation_Click()
On Error GoTo err_Handler

Dim y As Object

msgbox ExportRequest, vbInformation, "Finished"
'Application.FollowHyperlink CurrentProject.Path & "\template for bol variances.xls"

DoCmd.SetWarnings False

Set y = GetObject(, "Excel.Application")
'y.DisplayAlerts = False
'y.Save
y.Quit
Set y = Nothing

DoCmd.OpenQuery "appendboltracker"
DoCmd.OpenQuery "delboltracker"



DoCmd.SetWarnings True
msgbox "Now sending to Outlook", , "Notification"

'********************************************************************************

Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem
Dim strTo, strbody As String
Dim strcc As String
Dim varitem As Variant

DoCmd.SetWarnings False


'**creates an instance of Outlook
Set objOutlook = CreateObject("Outlook.application")
Set objEmail = objOutlook.CreateItem(olMailItem)

'**************************************************************
'*create string with email address

'For Each varitem In lboemail.ItemsSelected
For Each varitem In w6lboemailto.ItemsSelected

strTo = strTo & ";" & w6lboemailto.ItemData(varitem)
Next varitem
strTo = Mid(strTo, 2)

For Each varitem In w6lboemailcc.ItemsSelected
strcc = strcc & ";" & w6lboemailcc.ItemData(varitem)
Next varitem
strcc = Mid(strcc, 2)




strbody = strbody & "This template is to be used to report all inventory variances occuring from shipments received from the Brampton Distribution Center (W6/W7). " & Chr(13) & Chr(13) & Chr(13)
strbody = strbody & "Store:" & Chr(13) & Chr(13)
strbody = strbody & "BOL Number:" & Chr(13) & Chr(13)
strbody = strbody & "Total Amount of claim (from cell C2):" & Chr(13) & Chr(13)
strbody = strbody & "**********************************"

With objEmail
.To = strTo

.CC = strcc


.Body = strbody
.Subject = "W6 Inventory Variance Claim"
.Attachments.Add (CurrentProject.Path & "\template for bol variances.xls")
.Display
End With

Set objEmail = Nothing
'****closes Outlook. remove if you do not want to close Outlook

Exit Sub

'*************************************************************************************

DoCmd.SetWarnings True

'End Function[/color]


DoCmd.Close acForm, "Claimstobesent"
DoCmd.Close acForm, "frmexportclaim"

exit_Here:
Exit Sub
err_Handler:
msgbox Err.Description, vbCritical, "Error"
Resume exit_Here

DoCmd.Close acForm, "frmexportclaim"
End Sub


Public Function ExportRequest() As String
On Error GoTo err_Handler

' Excel object variables
Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet

Dim sTemplate As String
Dim sTempFile As String
Dim sOutput As String

Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim sSQL As String
Dim lRecords As Long
Dim iRow As Integer
Dim iCol As Integer
Dim iFld As Integer

Const cTabTwo As Byte = 1
Const cStartRow As Byte = 9
Const cStartColumn As Byte = 1

DoCmd.Hourglass True

' set to break on all errors
Application.SetOption "Error Trapping", 0

' start with a clean file built from the template file
sTemplate = "P:\Public\StoreOps\Eastern Canada\Loss Prevention\NVR\NVR templates\template for bol variances.xls"
sOutput = CurrentProject.Path & "\template for bol variances.xls"
If Dir(sOutput) <> "" Then Kill sOutput
FileCopy sTemplate, sOutput

' Create the Excel Applicaiton, Workbook and Worksheet and Database object
Set appExcel = Excel.Application
Set wbk = appExcel.Workbooks.Open(sOutput)
Set wks = appExcel.Worksheets(cTabTwo)


sSQL = "select * from qryboltracker"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
If Not rst.BOF Then rst.MoveFirst

' For this template, the data must be placed on the 9th row, first column.
' (these values are set to constants for easy future modifications)
iCol = cStartColumn
iRow = cStartRow

'Stop
Do Until rst.EOF
iFld = 0
lRecords = lRecords + 1
Me.lblMsg.Caption = "Exporting record #" & lRecords & " template for bol variances.xls"
Me.Repaint


For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
wks.Cells(iRow, iCol) = rst.Fields(iFld)

If InStr(1, rst.Fields(iFld).name, "Date") > 0 Then
wks.Cells(iRow, iCol).NumberFormat = "mm/dd/yyyy"
End If

wks.Cells(iRow, iCol).WrapText = False

iFld = iFld + 1
Next

wks.Rows(iRow).EntireRow.AutoFit
iRow = iRow + 1
rst.MoveNext
Loop

ExportRequest = "Total of " & lRecords & " rows processed."
Me.lblMsg.Caption = "Total of " & lRecords & " rows processed."

exit_Here:
' Cleanup all objects (resume next on errors)
On Error Resume Next
Set wks = Nothing
Set wbk = Nothing
Set appExcel = Nothing
Set rst = Nothing
Set dbs = Nothing
DoCmd.Hourglass False

Exit Function

err_Handler:
ExportRequest = Err.Description
Me.lblMsg.Caption = Err.Description
Resume exit_Here

End Function

 

[lameid]

I'm having trouble following your code... Obviously you would want to export the data before saving it but that obviously isn't done where you are trying to save... At least assuming the top procedure is the one that executes first...

Regardless, I think you want the saveas method of the workbook object... That means you need to know what workbook you are using...

 

[MJD1]

hi, I think that I did make the code a bit difficult to follow....

in any case i did figure it out using y.save. for some reason it's working now.

thanks!

 

[MazeWorX]

Because in your code yo commented it out

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work