automating access to excel to finished product

  • Thread starter Thread starter joemeshuggah
  • Start date Start date
J

joemeshuggah

is it possible to create a macro in access to run a series of pass through
queries, export the results of each query to specific workbooks in excel, and
then have those workbooks automatically run their respective macros for
formatting, pivot table creation, etc? is this a complicated task where one
would need extensive vba skills...or is it just a matter of a few simple
lines of code? what resources are out there that clearly explain this for
vba novices?
 
Hi Joe,

it is certainly possible to create VBA code in Access to do this -- but
it is not "a few simple lines of code"

"what resources are out there that clearly explain this for vba novices"

None that I know of. This task requires proficiency with VBA -- you can
start by reading Access Basics in my siggy. Since you want to become
proficient with VBA, be sure to follow all the links (there are lots of
them) and find out about other resources on the Internet.


Warm Regards,
Crystal

remote programming and training

Access Basics
8-part free tutorial that covers essentials in Access
http://www.AccessMVP.com/strive4peace

*
(: have an awesome day :)
*
 
Hello Joe,

Try this code and let me know if you want more.

grtz

Function createExcelDocument()
Dim db As Database
Dim rs As Recordset
Dim xlApp As Object 'Excel.Application
Dim xlBook As Object 'Excel.Workbook
Dim xlSheet As Object 'Excel.Worksheet
Dim xlRange As Object 'Excel.Range
Dim xlPrintRange As Object 'Excel.Range
Dim xlPageSetup As Object 'Excel.PageSetup
Dim I, J As Integer

'!<-- constants can be placed in a module as Global Const xlSolid = 1
etc....

Const xlSolid = 1
Const xlThin = 2
Const xlNone = -4142

Const xlDiagonalDown = 5
Const xlDiagonalUp = 6

Const xlEdgeLeft = 7
Const xlEdgeTop = 8
Const xlEdgeBottom = 9
Const xlEdgeRight = 10

Const xlContinuous = 1
Const xlAutomatic = -4105

Const xlDown = -4142
Const xlToLeft = -4159
Const xlPrintNoComments = -4142
Const xlPaperA4 = 9
Const xlDownThenOver = 1

'-->

On Error GoTo Error_createExcelDocument

Set db = CurrentDb

Set rs = db.OpenRecordset("SELECT * FROM MSysObjects") 'Put your one query
here

rs.MoveLast
rs.MoveFirst

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add()
Set xlSheet = xlBook.Worksheets(1)

'Maak eerste rij geel
Set xlRange = xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 29))

With xlRange.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With xlRange.Borders(xlDiagonalDown)
.LineStyle = xlNone
End With
With xlRange.Borders(xlDiagonalUp)
.LineStyle = xlNone
End With
With xlRange.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlRange.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlRange.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlRange.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

xlSheet.Cells(2, 1).Select
xlApp.ActiveWindow.FreezePanes = True

xlSheet.Cells(1, 1).Select

xlApp.Visible = True

For J = 0 To rs.Fields.Count - 1
xlSheet.Cells(1, J + 1) = rs.Fields(J).Name
Next J

For I = 1 To rs.RecordCount
For J = 0 To rs.Fields.Count - 1
'In this example only to skip binary fields
If rs.Fields(J).Type <> 11 Then
xlSheet.Cells(I + 1, J + 1) = rs.Fields(J).Value
End If
Next J
rs.MoveNext
Next I

'or
'xlSheet.Cells(1, 1).CopyFromRecordset rs ' is not always working

Exit Function

Error_createExcelDocument:

If Err = 3021 Then
MsgBox ("No records !"), vbCritical
ElseIf Err = 53 Then
Resume Next
Else
MsgBox ("Error " & Err & "(" & Err.Description & ") has occurred in
procedure <createExcelDocument> !"), vbCritical
xlApp.Quit
End If

DoCmd.Hourglass False

End Function
 
Back
Top