?
Solved

VBA Export to Excel with Autofit

Posted on 2014-12-12
12
Medium Priority
?
660 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 40497470
what do you mean by autofit?
0
 [eBook] Windows Nano Server

Download this FREE eBook and learn all you need to get started with Windows Nano Server, including deployment options, remote management
and troubleshooting tips and tricks

 

Author Comment

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

Expert Comment

by:Rey Obrero (Capricorn1)
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
 
LVL 31

Assisted Solution

by:Helen Feddema
Helen Feddema earned 400 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 120

Expert Comment

by:Rey Obrero (Capricorn1)
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 800 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 120

Assisted Solution

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

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

It’s the first day of March, the weather is starting to warm up and the excitement of the upcoming St. Patrick’s Day holiday can be felt throughout the world.
Microsoft Access is a place to store data within tables and represent this stored data using multiple database objects such as in form of macros, forms, reports, etc. After a MS Access database is created there is need to improve the performance and…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.

649 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