Solved

VBA Export to Excel with Autofit

Posted on 2014-12-12
12
398 Views
Last Modified: 2015-01-16
I need to modify this code to Autofit my Excel export from Access 2013.



Option Explicit

      Declare Function ShellExecute Lib "shell32.dll" Alias _
         "ShellExecuteA" (ByVal Hwnd As Long, ByVal lpOperation _
         As String, ByVal lpFile As String, ByVal lpParameters _
         As String, ByVal lpDirectory As String, ByVal nShowCmd _
         As Long) As Long

      Global Const SW_SHOWNORMAL = 1
Function ExportReports()

Dim exportFile As String
exportFile = "\\path\filename.xlsx"
If Len(Dir$(exportFile)) > 0 Then
     Kill exportFile
End If

DoCmd.TransferSpreadsheet acExport, , "MyQry-1", exportFile, True, "New-Tab-Name"
DoCmd.TransferSpreadsheet acExport, , "MyQry-2", exportFile, True, "New-Tab-Name"
DoCmd.TransferSpreadsheet acExport, , "MyQry-3", exportFile, True, "New-Tab-Name"
DoCmd.TransferSpreadsheet acExport, , "MyQry-4", exportFile, True, "New-Tab-Name"
DoCmd.TransferSpreadsheet acExport, , "MyQry-5", exportFile, True, "New-Tab-Name"

MsgBox "Reports File Updated!"
ShellExecute Application.hWndAccessApp, "Open", exportFile, "", "C:\", SW_SHOWNORMAL
End Function
0
Comment
Question by:CMILLER
  • 4
  • 4
  • 3
  • +1
12 Comments
 
LVL 26

Expert Comment

by:Nick67
ID: 40497448
Modify or replace?
CopyFromRecordset to an Newly created workbook is how I do that stuff.
Not TransferSpreadsheet and no API
0
 

Author Comment

by:CMILLER
ID: 40497457
This code deletes the file if its there.

Dim exportFile As String
 exportFile = "\\path\filename.xlsx"
 If Len(Dir$(exportFile)) > 0 Then
      Kill exportFile
 End If

Then I export a new file.

At this point, need to modify, if that the best thing to do.
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 40497470
what do you mean by autofit?
0
 

Author Comment

by:CMILLER
ID: 40497474
autofit the columns
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 40497499
you have to do that using VBA codes after the export.

dim xlObj as object
set xlObj=createobject("excel.application")
      xlObj.workbooks.open "\\path\filename.xlsx"
      with xlObj
            .worksheets("name of sheet").select
            .Columns("B:C").Select
            .Selection.Columns.AutoFit

            .activeworkbook.save
      end with
      
      xlObj.quit
      set xlObj=nothing
0
 
LVL 26

Expert Comment

by:Nick67
ID: 40497501
I know what you mean.
Have a look here
http://www.experts-exchange.com/Database/MS_Access/Q_28571045.html

You would leave this bit intact
Dim exportFile As String
 exportFile = "\\path\filename.xlsx"
 If Len(Dir$(exportFile)) > 0 Then
      Kill exportFile
 End If


The rest would be reworked along the lines of the link posted.
Read it through and let me know what I can do to help you knock yours into shape.

Once you've got an Excel automation on the go, autofitting is pretty straight forward

Format the columns for height and width
'Format the header row as bold and autofit the columns
 With oSheet.Range("a1").Resize(1, iNumCols)
 .Font.Bold = True
 .EntireColumn.AutoFit
 End With
0
Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

 
LVL 31

Assisted Solution

by:Helen_Feddema
Helen_Feddema earned 100 total points
ID: 40500599
I would recommend using the CopyFromRecordset method, as in this code (and afterwards apply AutoFit or any other Excel formatting you need):

On Error Resume Next
               Set appExcel = GetObject(, "Excel.Application")
               Set wkbTest = appExcel.Workbooks(strXLFileName)
               
               If Err.Number = 0 Then
                  'Workbook is already open
                  wkbTest.Close savechanges:=xlDoNotSaveChanges
                  Set wkbTest = Nothing
               End If
               
               Set wkb = appExcel.Workbooks.Open(FileName:=strXLFile, _
                  ReadOnly:=False)
               appExcel.Visible = True
               wkb.Activate
               
On Error GoTo ErrorHandler
               Set sht = wkb.Sheets("Access Data")
               
               'Clear old data, if any
               lngLastRow = sht.UsedRange.Rows.Count + 2
               strRange = "A3:Q" & CStr(lngLastRow)
               Set rng = sht.Range(strRange)
               rng.ClearContents
                              
               'Create a DAO recordset
               Set rng = sht.Range("A3")
               Set rstDAO = CurrentDb.OpenRecordset(strRecordSource)
               rng.CopyFromRecordset rstDAO
                                       
               strTitle = "Export successful"
               strPrompt = strXLFile & " filled with current Access data"
               MsgBox prompt:=strPrompt, _
                  Buttons:=vbInformation + vbOKOnly, _
                  Title:=strTitle

Open in new window

0
 

Author Comment

by:CMILLER
ID: 40508518
I dont know how to apply the AutoFit
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 40508551
dim xlObj as object
 set xlObj=createobject("excel.application")
       xlObj.workbooks.open "\\path\filename.xlsx"
       with xlObj

      ' select the name of the sheet
             .worksheets("name of sheet").select  
     
       ' select the  columns for autofit the next line selects columns B & C
             .Columns("B:C").Select
             .Selection.Columns.AutoFit

             .activeworkbook.save
       end with
       
       xlObj.quit
       set xlObj=nothing



<I dont know how to apply the AutoFit >  Explain.... what are the ccolumns you want to autofit?


.
0
 

Author Comment

by:CMILLER
ID: 40509610
oh, ok. I didnt know I needed to list the columns, I thought it would just autofit all of them.

For this example A-I
0
 
LVL 26

Accepted Solution

by:
Nick67 earned 200 total points
ID: 40509629
No

'Format the header row as bold and autofit the columns
  With oSheet.Range("a1").Resize(1, iNumCols)
  .Font.Bold = True
  .EntireColumn.AutoFit
  End With


This With oSheet.Range("a1").Resize(1, iNumCols) grabbed the top row, however many columns wide your data threw in.
This  .Font.Bold = True bolded the top row
This  .EntireColumn.AutoFit autofitted all the columns involved

But you do need to supply a range, even if that range is the whole sheet
0
 
LVL 119

Assisted Solution

by:Rey Obrero
Rey Obrero earned 200 total points
ID: 40509650
.Columns("A:I").Select
             .Selection.Columns.AutoFit
0

Featured Post

U.S. Department of Agriculture and Acronis Access

With the new era of mobile computing, smartphones and tablets, wireless communications and cloud services, the USDA sought to take advantage of a mobilized workforce and the blurring lines between personal and corporate computing resources.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction When developing Access applications, often we need to know whether an object exists.  This article presents a quick and reliable routine to determine if an object exists without that object being opened. If you wanted to inspect/ite…
I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
With Microsoft Access, learn how to start a database in different ways and produce different start-up actions allowing you to use a single database to perform multiple tasks. Specify a start-up form through options: Specify an Autoexec macro: Us…

895 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now