Access to Excel - from a query using early binding. Thanks!

[bill]

Hello,

I had a devil of a time using TRANSFERSPREADSHEET as, for whatever reason, the entire query would not be dumped to Excel. Assuming there were unprintable characters in table that abnormally abended the method.

Way back in 99 I remember writing code that used EARLY BINDING to mass create EXCEL files from Acess but for the life of me could not find that code so I dug around on this board for a while and had a hard time finding it here too.

I did find one example and from there worked a solution to my liking. I present the code below as I suppose a 'thank you' to the borad users for getting me started

Hope the code is to your liking!

Sub MakeExcel()
  MakeExcelGo "SYMP_PUBLIC_ALL_SOURCE", "c:\AllSource.xls"
End Sub

Sub MakeExcelGo(strQuery As String, strPath As String)

Dim xl As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet

Dim rs As DAO.Recordset

Dim cnt As Integer
Dim c As Long
Dim r As Long

  'Busines is still using Access 97 so DAO seems a natural choice
  'However, tried using ADO but could not find a substitue for the
  'property CurrentProject.Connection. You know what it is?  Do tell:)

  'Kill if the file already exisits
  If Trim(Dir(strPath)) <> "" Then Kill strPath

  ' Well, what can I say?  I'm a fool for variables:)
  Set xl = New Excel.Application
  Set xlWB = xl.Workbooks.Add
  Set xlWS = xlWB.ActiveSheet

  'Default of VISIBLE is FALSE but didn't want to take a chance - Needed Speed!
  'In addition, set the other parms to hopefully gain more performance
  xl.Visible = False
  xl.ScreenUpdating = False
  xl.Calculation = xlCalculationManual
  
  xlWS.Name = strQuery
  
  'open Query/table here
  'Using FORWARDONLY as it is the fastest cursor for this type of work
  Set rs = CurrentDb.OpenRecordset(strQuery, dbOpenForwardOnly)
  'Find out how many columns in the query
  cnt = rs.Fields.Count
  
  'Build Headings from the column names!
  For c = 1 To cnt
    xlWS.Cells(1, c) = rs.Fields(c - 1).Name
  Next c

  r = 2
  'Start writing to Excel worksheet
  'Notice use of CLEAN.  It is an Excel worksheet function that
  'removes non-printable characters from a string.
  'There is a bit of overhead involved in invoking the method but
  'worth it I suppose since the TRANSFERSHREADSHEET bombed out for
  '(I assume) non printable characters.
  Do Until rs.EOF
    For c = 1 To cnt
      xlWS.Cells(r, c) = xl.WorksheetFunction.Clean(rs.Fields(c - 1))
    Next
    rs.MoveNext
    r = r + 1
  Loop

  'Pretty work. Lock the heading on the first row and hopefully, make
  ' the worksheet more readable.
  xl.ActiveWindow.SplitRow = 1
  xl.ActiveWindow.FreezePanes = True
  xl.ActiveWindow.Zoom = 60

  xlWS.Range("A1").Select
  xlWS.Rows("1:1").Font.Bold = True
  
  xlWS.Cells.Font.Name = "Courier New"
  xlWS.Cells.EntireColumn.AutoFit

  'Cleanup!
  Set xlWS = Nothing

  xlWB.SaveAs strPath

  'Cleanup!
  xlWB.Close:  Set xlWB = Nothing
  xl.Quit:     Set xl = Nothing

End Sub