Option Compare Database
Option Explicit
'---------------------------------------------------------------------------------------
' RxMiller on this forum - Other than the SqL code - this is about as simple as it gets
' Access code - one form to create an Excel worksheet
' Procedure : cmdCancel_Click
' Purpose :Access Form - offer a cancel button
'---------------------------------------------------------------------------------------
Private Sub cmdCancel_Click()
10 On Error GoTo PROC_ERROR
20 DoCmd.Close acForm, Me.Name
PROC_EXIT:
30 On Error Resume Next
40 Exit Sub
PROC_ERROR:
50 Select Case Err.Number ' used to track errors - just comment out if not needed
Case Else ' functionLogMyErroris a centralized Error tracking function - not shown
60 functionLogMyError Err.Number, Erl, Err.Description, "Form_ThisFormName", "cmdCancel_Click", True
70 Resume PROC_EXIT
80 End Select
End Sub
'------------------------------------------------------------------------------------------------------
' Procedure : cmdExport_Click
' Purpose : Create Excel - add headers, read Access data, bring in data, and simple format
' Me.cboMonth this form has a combo box with a list of Months - used in the SQL statement "Having" statement
'------------------------------------------------------------------------------------------------------
Private Sub cmdExport_Click()
Dim objXL As Object
Dim strSQL As String
Dim rsExport As DAO.Recordset
Dim bytFieldPos As Byte
10 On Error GoTo PROC_ERROR
20 Set objXL = CreateObject("Excel.Application")
25 'objXL.Visible = True ' to step through code (troubleshoot) uncomment - then remember to re-comment
30 DoCmd.Hourglass True ' let user know to wait
40 objXL.Application.Workbooks.Add
45 ' Actual table / fields changed to post - Create an SQL statement with Access tools. break the SQL string apart here - Your on your own
50 strSQL = "SELECT tblSales.lngContractNo AS Deal, tblCustomers.strCompanyName AS Counterparty, tblSalesdetails.dtTransaction " & _
"AS [Date], IIf([bytBuyOrSell],'Buy','sell') AS buySell, tblStoress.strStores AS [Deal Stores], tblMarketAreas.strMarketArea AS [Deal MA], " & _
"Sum(tblSalesdetails.lngVolume) AS [Deal Vol], Sum([lngVolume]*([curPrice]+nz([curPricingPremiumDiscount],0))*IIf([bytBuyOrSell]=1,1,-1)) " & _
"AS [Deal Value], " & _
"tblStoress_1.strStores AS [Delivery Stores], tblMarketAreas_1.strMarketArea AS [Delivery MA], tblMailDrops.strMailDropDesc AS " & _
"[Delivery Point], Sum(tblScheduleDetails.lngNominalVolume) AS [Nom Vol], Sum([lngNominalVolume]*([curPrice]+nz([curPricingPremiumDiscount],0)) " & _
"*IIf([bytBuyOrSell]=1,1,-1)) AS [Nom Value], Sum(tblScheduleDetails.lngActualVolume) AS [Act Vol], " & _
"Sum([lngActualVolume]*([curPrice]+nz([curPricingPremiumDiscount],0))*IIf([bytBuyOrSell]=1,1,-1)) AS [Act Value], tblAccounts.strAccountName " & _
"AS [Deal Account], tblAccounts.strAccountName AS [Delivery Account] " & _
"FROM ((((((tblMailDrops LEFT JOIN tblMarketAreas AS tblMarketAreas_1 ON tblMailDrops.lngMarketAreaID = tblMarketAreas_1.lngMarketAreaID) " & _
"RIGHT JOIN (((tblSales RIGHT JOIN tblSalesdetails ON tblSales.lngContractNo = tblSalesdetails.lngContractNo) LEFT JOIN tblScheduleDetails " & _
"ON tblSalesdetails.lngContractDetailID = tblScheduleDetails.lngContractDetailID) " & _
"LEFT JOIN tblMarketAreas ON tblSales.lngMarketAreaID = tblMarketAreas.lngMarketAreaID) " & _
"ON tblMailDrops.intMailDropID = tblScheduleDetails.intMailDropID) " & _
"LEFT JOIN tblCustomers ON tblSales.lngCustomerID = tblCustomers.lngCustomerID) " & _
"LEFT JOIN tblAccounts ON tblMarketAreas.bytAccountID = tblAccounts.bytAccountID) " & _
"LEFT JOIN tblAccounts AS tblAccounts_1 ON tblMarketAreas_1.bytAccountID = tblAccounts_1.bytAccountID) " & _
"LEFT JOIN tblStoress ON tblSales.intStoresID = tblStoress.intStoresID) " & _
"LEFT JOIN tblStoress AS tblStoress_1 ON tblMarketAreas_1.intStoresID = tblStoress_1.intStoresID " & _
"WHERE (((tblMarketAreas_1.bytAccountID) <> [tblMarketAreas].[bytAccountID])) " & _
"GROUP BY tblSales.lngContractNo, tblCustomers.strCompanyName, tblSalesdetails.dtTransaction, IIf([bytBuyOrSell],'Buy','sell'), " & _
"tblStoress.strStores, tblMarketAreas.strMarketArea, tblStoress_1.strStores, tblMarketAreas_1.strMarketArea, " & _
"tblMailDrops.strMailDropDesc, tblAccounts.strAccountName, tblAccounts.strAccountName " & _
"HAVING (((tblSalesdetails.dtTransaction) Between #" & Me.cboMonth & "# And #" & DateSerial(Year(Me.cboMonth), Month(Me.cboMonth) + 1, 0) & "#)) " & _
"ORDER BY tblSales.lngContractNo, tblSalesdetails.dtTransaction"
55 ' The strsql should have the same string as your Access SQL text at this point - This just shows how big you can really make it
60 Set rsExport = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
70 objXL.Worksheets(1).Cells(2, 1).copyfromrecordset rsExport
'Add Headers to Worksheet
80 For bytFieldPos = 0 To rsExport.Fields.count - 1 ' Read the Record set's Field Names and create the header - we counted the number of columns for the loop
90 objXL.Worksheets(1).Cells(1, bytFieldPos + 1) = rsExport.Fields(bytFieldPos).Name ' Use SQL "AS Deal" for example to provide column names
100 Next bytFieldPos ' the count of the colomns matches the Excel columns
110 With objXL
120 .Range("G:G,L:L,N:N").Select ' Non-contigous column range - to format for numbers
130 .Selection.NumberFormat = "#,##0_);[Red](#,##0)"
140 .Range("H:H,M:M,O:O").Select
150 .Selection.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
160 .Range("A1").Select
170 .ActiveWindow.SplitRow = 1
180 .ActiveWindow.FreezePanes = True
190 .Columns("A:Q").EntireColumn.AutoFit
200 End With
210 DoCmd.Close acForm, Me.Name
PROC_EXIT:
220 On Error Resume Next
230 DoCmd.Hourglass False
240 objXL.Visible = True ' the process will run much faster if Excel is invisible, then appears when process is finished
250 rsExport.Close
260 Set rsExport = Nothing
270 Exit Sub
PROC_ERROR:
280 Select Case Err.Number
'Case ### ' create a function functionLogMyErrorto keep track of errors
Case Else
290 functionLogMyError Err.Number, Erl, Err.Description, "Form_ThisFormName", "cmdCancel_Click", True
300 Resume PROC_EXIT
310 End Select
End Sub
'---------------------------------------------------------------------------------------
' Procedure : Form_Load
' Purpose : Form with cbo month list box - cmdCancel - cmdExport controls - set date to last month
'---------------------------------------------------------------------------------------
Private Sub Form_Load()
10 On Error GoTo PROC_ERROR
20 Me.cboMonth = DateSerial(Year(Date), Month(Date) - 1, 1) ' A combo box with last month's date as the default
30 ' optionally, you could just replace the me.cboMonth here and in SQL text with a variable
PROC_EXIT:
40 On Error Resume Next
50 Exit Sub
PROC_ERROR:
60 Select Case Err.Number
'Case ###
Case Else
70 functionLogMyError Err.Number, Erl, Err.Description, "Form_ThisFormName", "Form_Load", True
80 Resume PROC_EXIT
90 End Select
End Sub
Bookmarks