UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Query Export To Run Excel Macro On Open, Access 2016    
 
   
KathCobb
post May 16 2020, 05:16 PM
Post#1



Posts: 535
Joined: 18-October 06



I've been looking around for awhile to see if there is a method to format a query/export to excel spreadsheet on open. Particularly Column Width. We have an export to excel button that is based on a query after a user selects some options on a form. When the query exports to excel, it asks you to save it, then it opens automatically. My issue is we have a two letter State column that on export, for some reason, it's width is set to 127.65, which takes up half of a 27 inch screen. There are 4 different columns that open ridiculously wide. Is there any work around for this?

Any and all help is appreciated.
Thanks in advance smile.gif
Kathy

--------------------
I know the basics, which is probably just enough to be dangerous...
Go to the top of the page
 
ADezii
post May 16 2020, 06:13 PM
Post#2



Posts: 3,089
Joined: 4-February 07
From: USA, Florida, Delray Beach


You can use Automation Code to Format an Excel Spreadsheet after-the-fact. Let's assume you Exported a Query to Sheet1 in the Workbook C:\Test\Demo.xlsx and the Column Widths of A and B are not what they should be. The following Code will: open the Workbook, Activate Sheet1, and AutoFit Columns A and B. The Images how the results both before and after Code Execution.
CODE
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim sht As Excel.Worksheet

Set appExcel = New Excel.Application
Set wkb = appExcel.Workbooks.Open("C:\Test\Demo.xlsx")
Set sht = wkb.Worksheets("Sheet1")

sht.Activate
sht.Columns("A:B").AutoFit

wkb.Close SaveChanges:=True

appExcel.Quit
Set sht = Nothing
Set wkb = Nothing
Set appExcel = Nothing

Attached File(s)
Attached File  Sheet_Before.JPG ( 32.3K )Number of downloads: 1
Attached File  Sheet_After.JPG ( 24.92K )Number of downloads: 0
 
Go to the top of the page
 
KathCobb
post May 16 2020, 06:38 PM
Post#3



Posts: 535
Joined: 18-October 06



I guess I should have included more details... I need a code like to run as part of the export query from Access. I won't be the one using this. My users are not computer savvy which is why I had to create a select form to open a query. The user will run the query and they can choose any file name they want, so the code cannot be tied to a specific excel file name, it has to run when the query exports and automatically opens up the saved file. Is that something that can be done? I'm assuming the code below is for access to tell excel to open that specific file.

--------------------
I know the basics, which is probably just enough to be dangerous...
Go to the top of the page
 
tina t
post May 17 2020, 01:35 AM
Post#4



Posts: 6,685
Joined: 11-November 10
From: SoCal, USA


QUOTE
My users are not computer savvy which is why I had to create a select form to open a query. The user will run the query and they can choose any file name they want, so the code cannot be tied to a specific excel file name, it has to run when the query exports and automatically opens up the saved file.

hi Kathy, can you post the complete VBA code you're using to export the query, pls?

hth
tina

ps. is it time to update your tagline? ;)

--------------------
"the wheel never stops turning"
Go to the top of the page
 
projecttoday
post May 17 2020, 09:20 AM
Post#5


UtterAccess VIP
Posts: 12,391
Joined: 10-February 04
From: South Charleston, WV


Try adding .CopyFromRecordset to ADezii's code.

--------------------
Robert Crouser
Go to the top of the page
 
projecttoday
post May 17 2020, 09:23 AM
Post#6


UtterAccess VIP
Posts: 12,391
Joined: 10-February 04
From: South Charleston, WV


Well, yes, I would say to tina's suggestion. Kath has been posting since 2006 ...

--------------------
Robert Crouser
Go to the top of the page
 
ADezii
post May 17 2020, 09:30 AM
Post#7



Posts: 3,089
Joined: 4-February 07
From: USA, Florida, Delray Beach


QUOTE
The user will run the query and they can choose any file name they want, so the code cannot be tied to a specific excel file name, it has to run when the query exports and automatically opens up the saved file. Is that something that can be done? I'm assuming the code below is for access to tell excel to open that specific file.The user will run the query and they can choose any file name they want, so the code cannot be tied to a specific excel file name, it has to run when the query exports and automatically opens up the saved file. Is that something that can be done? I'm assuming the code below is for access to tell excel to open that specific file.

The Code is not restricted to a specific File, that is for demonstration purposes only.
QUOTE
The user will run the query and they can choose any file name they want,

Once the User chooses a Filename, it can be assigned to a Variable, then substituted into the Code as the Workbook Path (Ref# 1 below).
CODE
Dim strFile as String
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim sht As Excel.Worksheet

strFile = "<User chosen Filename & Path>", as in
strFile = "C:\Exports\2020\May\Monthly_Sales.xlsx"

Set appExcel = New Excel.Application
Set wkb = appExcel.Workbooks.Open(strFile)              'Ref# 1
Set sht = wkb.Worksheets("Sheet1")

sht.Activate
sht.Columns("A:B").AutoFit

wkb.Close SaveChanges:=True

appExcel.Quit
Set sht = Nothing
Set wkb = Nothing
Set appExcel = Nothing

P.S. - Can you Post the Code as tina t requested in Post# 4?
This post has been edited by ADezii: May 17 2020, 09:37 AM
Go to the top of the page
 
KathCobb
post May 17 2020, 07:52 PM
Post#8



Posts: 535
Joined: 18-October 06



Sorry, I’ve been super busy but will come back to this before the week is out.

I’m actually having a friend help me write the export code because of the many selections I wanted the user to be able to make and I couldn’t get the and/or’s to work right. Query’s are really hard for me once joins are involved.

I did a lot to try and learn vba on my own about ten years ago and then I did nothing with it and forgot a lot of what I learned. I really only have the very basics down. I use excel macros a lot now because I can use the macro recorder and with that, google and the aid of some books, I can usually figure out what I need to get something accomplished. I’m betting that the way most of my code “works” would get many many head shakes here. That’s why most of my questions start with can this even be done or am I searching for the impossible.

Thank you so much and promise to get back with that export code ASAP and hopefully I can figure out how to incorporate this into it if everyone is still willing to help 😃

Kath

--------------------
I know the basics, which is probably just enough to be dangerous...
Go to the top of the page
 
KathCobb
post May 22 2020, 10:02 AM
Post#9



Posts: 535
Joined: 18-October 06



Ok, here is the code. There is a lost of selection criteria available to build the query, then a button toped it. This is not all my code, I had a much simpler SQL query that we started with and then needed too add more criteria. Can the code suggested above be integrated in to this? That would be fantastic.

CODE
Private Sub CreateQuery()
Dim db As DAO.Database, oQuery As QueryDef
Dim strSELECT As String, strFROM As String, strWhere As String, strORDER As String

'   Initial SQL code
    strSELECT = "SELECT tblAgentDetail.AgentLastName, tblAgentDetail.AgentFirstName, " & _
        "tblInsuranceCompanies.Company, tblInsurancePlanType.PlanType, " & _
        "tblInsuranceCompanyPlanLink.PlanName, tblClient.ClientLastName, " & _
        "tblClient.ClientFirstName, tblClient.ClientPhoneNumber, " & _
        "qryExportMailingAddress.StreetAddress, qryExportMailingAddress.ZipCity AS City, " & _
        "qryExportMailingAddress.ZipState AS State, qryExportMailingAddress.ZipCode AS Zip, " & _
        "qryExportMailingAddress.ZipCounty AS County, tblClient.Medicaid, tblClient.EPIC, " & _
        "tblPolicySales.PolicyEffectiveDate, tblPolicySales.PolicyDateSigned, tblTrustAnnu.PolicyAmount"
    strFROM = " FROM ((tblInsurancePlanType INNER JOIN ((tblInsuranceCompanies " & _
        "INNER JOIN tblInsuranceCompanyPlanLink ON tblInsuranceCompanies.pkInsuranceCompanyID = tblInsuranceCompanyPlanLink.fkInsuranceCompanyID) " & _
        "INNER JOIN (tblClient INNER JOIN (tblAgentDetail INNER JOIN tblPolicySales ON tblAgentDetail.pkAgentID = tblPolicySales.fkAgentID) " & _
        "ON tblClient.pkClientID = tblPolicySales.fkClientID) ON tblInsuranceCompanyPlanLink.pkInsuranceCompanyPlanLink = tblPolicySales.fkInsuranceCompanyPlanLink) " & _
        "ON tblInsurancePlanType.pkInsurancePlanTypeID = tblInsuranceCompanyPlanLink.fkInsurancePlanTypeID) " & _
        "LEFT JOIN tblTrustAnnu ON tblPolicySales.pkSalesID = tblTrustAnnu.pkTrustAnnuID) " & _
        "LEFT JOIN qryExportMailingAddress ON tblClient.pkClientID = qryExportMailingAddress.fkClientID"
    If Me.ckboxInactive = False Then
        strWhere = " WHERE (tblClient.ClientInactiveDate Is Null) And (tblClient.Deceased = false) And (tblPolicySales.PolicyCanceledDate Is Null)"
    Else
        strWhere = " WHERE (tblClient.ClientInactiveDate Is not Null) And (tblClient.Deceased = false)"
    End If
    strORDER = " ORDER BY tblAgentDetail.AgentLastName, tblAgentDetail.AgentFirstName, tblInsuranceCompanies.Company, tblInsurancePlanType.PlanType, tblInsuranceCompanyPlanLink.PlanName, tblClient.ClientLastName, tblClient.ClientFirstName, qryExportMailingAddress.ZipCity, qryExportMailingAddress.ZipCode"
'Debug.Print "start " & Now()
'   Edit SQL based on selections
    
    'SELECT CRITERIA
    If strSelectAgent <> "" And strSelectAgent <> "0" Then
        strWhere = strWhere & " And (tblPolicySales.fkAgentID in (" & strSelectAgent & "))"
    End If
    If IsNull(Me.cboSelectState) = False And Me.cboSelectState <> "(All)" Then
        strWhere = strWhere & " And (tZip_Code.ZipState = '" & Me.cboSelectState & "')"
    End If
    If strSelectCounty <> "0" And strSelectCounty <> "" Then
        strWhere = strWhere & " And (tZip_Code.ZipCounty in (" & strSelectCounty & "))"
    End If
    If IsNull(Me.cboSelectCompany) = False And Me.cboSelectCompany <> 0 Then
        strWhere = strWhere & " And (tblInsuranceCompanyPlanLink.fkInsuranceCompanyID = " & Me.cboSelectCompany & ")"
    End If
    If strSelectPlanType <> "" And strSelectPlanType <> "0" Then
        strWhere = strWhere & " And (tblInsurancePlanType.pkInsurancePlanTypeID in (" & strSelectPlanType & "))"
    End If
    
    'Dates - both or just one date entered
    If IsNull(Me.dtStart) = False And IsNull(Me.dtEnd) = False Then
        If Me.frmeDate = 1 Then
            strWhere = strWhere & " And (tblPolicySales.PolicyDateSigned >= #" & Me.dtStart & "# and tblPolicySales.PolicyDateSigned <= #" & Me.dtEnd & "#)"
        Else
            strWhere = strWhere & " And (tblPolicySales.PolicyEffectiveDate >= #" & Me.dtStart & "# and tblPolicySales.PolicyEffectiveDate <= #" & Me.dtEnd & "#)"
        End If
    ElseIf IsNull(Me.dtStart) = False And IsNull(Me.dtEnd) Then
        If Me.frmeDate = 1 Then
            strWhere = strWhere & " And (tblPolicySales.PolicyDateSigned >= #" & Me.dtStart & "#)"
        Else
            strWhere = strWhere & " And (tblPolicySales.PolicyEffectiveDate >= #" & Me.dtStart & "#)"
        End If
    ElseIf IsNull(Me.dtStart) And IsNull(Me.dtEnd) = False Then
        If Me.frmeDate = 1 Then
            strWhere = strWhere & " And (tblPolicySales.PolicyDateSigned  <= #" & Me.dtEnd & "#)"
        Else
            strWhere = strWhere & " And (tblPolicySales.PolicyEffectiveDate  <= #" & Me.dtEnd & "#)"
        End If
    End If
    
    'Medicaid and Epic
    If Me.frmeOptions = 2 Then
        strWhere = strWhere & " And (tblClient.Medicaid = true)"
    ElseIf Me.frmeOptions = 3 Then
        strWhere = strWhere & " And (tblClient.EPIC = true)"
    End If
'Debug.Print strWhere
    
    'JOIN AND OUTPUT FIELD OPTIONS
    If Me.ckboxInactive = True Then
        'Replace from to include join to query with last cancelled policy
        strFROM = " FROM (((tblInsurancePlanType INNER JOIN ((tblInsuranceCompanies  " & _
            "INNER JOIN tblInsuranceCompanyPlanLink ON tblInsuranceCompanies.pkInsuranceCompanyID = tblInsuranceCompanyPlanLink.fkInsuranceCompanyID)  " & _
            "INNER JOIN (tblClient INNER JOIN (tblAgentDetail INNER JOIN tblPolicySales ON tblAgentDetail.pkAgentID = tblPolicySales.fkAgentID)  " & _
            "ON tblClient.pkClientID = tblPolicySales.fkClientID) ON tblInsuranceCompanyPlanLink.pkInsuranceCompanyPlanLink = tblPolicySales.fkInsuranceCompanyPlanLink)  " & _
            "ON tblInsurancePlanType.pkInsurancePlanTypeID = tblInsuranceCompanyPlanLink.fkInsurancePlanTypeID)  " & _
            "LEFT JOIN tblTrustAnnu ON tblPolicySales.pkSalesID = tblTrustAnnu.pkTrustAnnuID)  " & _
            "LEFT JOIN qryExportMailingAddress ON tblClient.pkClientID = qryExportMailingAddress.fkClientID)  " & _
            "INNER JOIN qryExportPolicyCancelled ON (tblPolicySales.fkClientID = qryExportPolicyCancelled.fkClientID) AND (tblPolicySales.PolicyCanceledDate = qryExportPolicyCancelled.MaxOfPolicyCanceledDate)"
        'Add to selected fields
        strSELECT = strSELECT & ", tblPolicySales.PolicyCanceledDate"
    End If
    
     If Me.ckboxTrustAnnuityInfo = True Then
        'Add to selected fields
        strSELECT = strSELECT & ", tblTrustAnnu.TrustAmount, tblTrustAnnu.TrustDateCompleted, tblTrustAnnu.TrustPenaltyEndDate"
    End If
  
Set db = CurrentDb
Set oQuery = db.QueryDefs("Export_Client_List")
oQuery.SQL = strSELECT & strFROM & strWhere & strORDER
Set oQuery = Nothing
Set db = Nothing
'Debug.Print "end " & Now()
End Sub


Private Sub cmdQryExport_Click()
    'Create query based on select criteria
    CreateQuery
    
    'Check on results
    intRec = DCount("*", "Export_Client_List")
    If intRec = 0 Then
        MsgBox "No results found for the selected criteria.", vbExclamation
    Else
        intMsg = MsgBox("Results ready with " & intRec & " records selected." & vbCr & vbCr & _
            "Proceed to Export?", vbQuestion + vbOKCancel, "Export Results")
        If intMsg = vbOK Then
            DoCmd.OutputTo acOutputQuery, "Export_Client_List", "ExcelWorkbook(*.xlsx)", "", True, "", 0, acExportQualityScreen
        End If
    End If

End Sub

--------------------
I know the basics, which is probably just enough to be dangerous...
Go to the top of the page
 
ADezii
post May 22 2020, 02:51 PM
Post#10



Posts: 3,089
Joined: 4-February 07
From: USA, Florida, Delray Beach


  1. For the purposes of this conversation, I am only posting the portion of your Code that is relevant to this conversation with one change.
  2. I am making the major assumption that the Query (Export_Client_List) exported without any problems.
  3. Copy and paste the following API Declaration into a Standard Code Module, I'll explain its purpose shortly:
    CODE
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  4. I made a change to the OutputTo Statement so that the Query will Export to the same Folder as your Database. The Logic behind this is to avoid the Save Prompt which will be very disruptive to the remaining Code.
    CODE
    DoCmd.OutputTo acOutputQuery, "Export_Client_List", "ExcelWorkbook(*.xlsx)", CurrentProject.Path & _
                                  "\Export_Client_List.xlsx", True, "", 0, acExportQualityScreen
  5. After the OutputTo Statement, my Code will take over.
  6. The added Code will:
    1. Delay for 6 seconds (modify to your specific need) to allow for the Query to be Exported, then open Excel displaying the Query Results. The Value passed to the Sleep() Sub-Routine is in milliseconds.
    2. Set an Object Variable to the Running Instance of Excel which should be Export_Client_List.xlsx.
    3. Set Workbook and Worksheet Object Variables accordingly.
    4. Determine the number of Fields/Columns in the Export_Client_List Worksheet which is named after the Query.
    5. Autofit Columns A to Chr$(65 + Number of Fields/Columns -1) which equates to A to D if 4 Columns.
    6. Save the Workbook with Excel still Open.
    7. Don't forget that you may need to adjust the Value passed to the Sleep Routine.
  7. Code Definition:
    CODE
    '**************************** CODE ABOVE THIS POINT HAS NOT BEEN POSTED ****************************
    Dim intRec As Integer, intMsg As Integer

    'Check on results
    intRec = DCount("*", "Export_Client_List")
    If intRec = 0 Then
      MsgBox "No results found for the selected criteria.", vbExclamation
        Exit Sub       'gotta get out of Dodge!
    Else
      intMsg = MsgBox("Results ready with " & intRec & " records selected." & vbCr & vbCr & _
                      "Proceed to Export?", vbQuestion + vbOKCancel, "Export Results")
        If intMsg = vbOK Then
          DoCmd.OutputTo acOutputQuery, "Export_Client_List", "ExcelWorkbook(*.xlsx)", CurrentProject.Path & _
                                        "\Export_Client_List.xlsx", True, "", 0, acExportQualityScreen
        End If
    End If

    Sleep 6000      '6 second delay, may need to be adjusted (Value is in milliseconds)

    Dim appExcel As Object
    Dim wkb As Object
    Dim wks As Object
    Dim intNumOfCols As Integer

    'How many Fields/Columns are in the Table
    intNumOfCols = CurrentDb.QueryDefs("Export_Client_List").Fields.Count

    'Get the Running Instance of Excel, should be Export_Client_List.xlsx
    Set appExcel = GetObject(, "Excel.Application")
        appExcel.Visible = True
        
    Set wkb = appExcel.Workbooks(1)     'Set Reference to the Workbook
    Set wks = wkb.Worksheets(1)         'Reference to the only Worksheet that exists named Export_Client_List

    wks.Columns("A:" & Chr$(65 + (intNumOfCols - 1))).AutoFit       'Autofit Columns A to number of Columns - 1

    wkb.Save    'Save the Workbook
  8. The Code has been tested and works as intended.

This post has been edited by ADezii: May 22 2020, 02:54 PM
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    9th July 2020 - 09:12 AM