• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 713
  • Last Modified:

VBA Export to Excel with Autofit

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
CMILLER
Asked:
CMILLER
  • 4
  • 4
  • 3
  • +1
3 Solutions
 
Nick67Commented:
Modify or replace?
CopyFromRecordset to an Newly created workbook is how I do that stuff.
Not TransferSpreadsheet and no API
0
 
CMILLERAuthor Commented:
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
 
Rey Obrero (Capricorn1)Commented:
what do you mean by autofit?
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
CMILLERAuthor Commented:
autofit the columns
0
 
Rey Obrero (Capricorn1)Commented:
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
 
Nick67Commented:
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
 
Helen FeddemaCommented:
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
 
CMILLERAuthor Commented:
I dont know how to apply the AutoFit
0
 
Rey Obrero (Capricorn1)Commented:
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
 
CMILLERAuthor Commented:
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
 
Nick67Commented:
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
 
Rey Obrero (Capricorn1)Commented:
.Columns("A:I").Select
             .Selection.Columns.AutoFit
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

  • 4
  • 4
  • 3
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now