Solved

VBA Export to Excel with Autofit

Posted on 2014-12-12
12
520 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
MS Dynamics Made Instantly Simpler

Make Your Microsoft Dynamics Investment Count  & Drastically Decrease Training Time by Providing Intuitive Step-By-Step WalkThru Tutorials.

 

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 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 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 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 120

Assisted Solution

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

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
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…
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …

707 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