export table to excel and format----(using office 2000)

G

Guest

I have some code in an access button that exports some tables (actually
linked views) into an excel spreadsheet and saves it in a folder on the
server. I then run a formatting macro that is saved in my personal.xls
workbook. I would like the code in access to automatically run the
formatting macro in excel before saving the workbook.

I've learned how to run an outlook macro from excel by using a reference and
think there should be some similar way of doing this with access but I can't
seem to figure it out.

Thanks,
Billy
Dallas,TX


Here's the Access Code

Private Sub cmdAssocGenerator_Click()
Dim FullFileName, Table1, Table2, Table3, Table4

Table1 = "dbo_Assoc10-Demographics&Volume&CB"
Table2 = "dbo_Assoc10-Equipment"
Table3 = "dbo_Assoc10-InvoiceMast"
Table4 = "dbo_Assoc10-InvoiceMast QA"
FullFileName = "n:\Data Warehouse\Dallas\Canada Ad Hocs\" &
txtFileName.Value & ".xls"

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, Table1,
FullFileName, Yes
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, Table2,
FullFileName, Yes
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, Table3,
FullFileName, Yes
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, Table4,
FullFileName, Yes




MsgBox "DONE!", vbOKOnly, "Exporting Finished"


End Sub


Here is the Excel Formatting Macro


Sub Canada_Assoc_Ad_Hoc_Format()
'
' Canada_Assoc_Ad_Hoc_Format Macro
' Formats Canada Ad HocAssoc Report
'


Sheets("dbo_Assoc10_Demographics_Volume").Select
With ActiveSheet.PageSetup
..LeftHeader = "CannedReportingMASSCanada.mdb"
..CenterHeader = Workbooks.Application.ActiveWorkbook.Name
..RightHeader = "&P" & " of " & "&N"
..LeftFooter = "N:\Data Warehouse\Dallas\Canada Ad Hocs"
..CenterFooter = ""
..RightFooter = "Created by " & Application.UserName & ", on &D"


..FirstPageNumber = xlAutomatic
End With



Range("A1", Range("IV1").End(xlToLeft)).Select

' Rows("1:1").Select
With Selection.Interior
..ColorIndex = 15
..Pattern = xlSolid
End With
Sheets("dbo_Assoc10_Equipment").Select
Range("A1", Range("IV1").End(xlToLeft)).Select
'Rows("1:1").Select
With Selection.Interior
..ColorIndex = 15
..Pattern = xlSolid
End With
Sheets("dbo_Assoc10_InvoiceMast").Select
Range("A1", Range("IV1").End(xlToLeft)).Select
'Rows("1:1").Select
With Selection.Interior
..ColorIndex = 15
..Pattern = xlSolid
End With
Sheets("dbo_Assoc10_InvoiceMast_QA").Select

Rows("1:1").Select
ActiveWindow.TabRatio = 0.853
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("dbo_Assoc10_Demographics_Volume").Select
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Sheets("dbo_Assoc10_Equipment").Select
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Sheets("dbo_Assoc10_InvoiceMast").Select
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Sheets("dbo_Assoc10_InvoiceMast_QA").Select
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("A1", Range("IV1").End(xlToLeft)).Select
' Rows("1:1").Select

With Selection.Interior
..ColorIndex = 15
..Pattern = xlSolid
End With
Selection.AutoFilter
Cells.Select
Range("B1").Activate
Cells.EntireColumn.AutoFit
Range("C2").Select
ActiveWindow.SmallScroll Down:=0
Sheets("dbo_Assoc10_InvoiceMast").Select
Cells.Select
Cells.EntireColumn.AutoFit
Range("C2").Select
ActiveWindow.SmallScroll Down:=0
Sheets("dbo_Assoc10_Equipment").Select
Cells.Select
Cells.EntireColumn.AutoFit
Range("C2").Select
ActiveWindow.ScrollWorkbookTabs Sheets:=-1
Sheets("dbo_Assoc10_Demographics_Volume").Select
Cells.Select
Cells.EntireColumn.AutoFit
ActiveWindow.SmallScroll ToRight:=9
Columns("N:O").Select
Selection.NumberFormat = "0.00"
ActiveWindow.SmallScroll ToRight:=-9
Range("D2").Select



Sheets("dbo_Assoc10_InvoiceMast").Select
ColumnTotal "F"
ColumnTotal "G"
ColumnTotal "H"
ColumnTotal "I"
Sheets("dbo_Assoc10_InvoiceMast_QA").Select
ColumnTotal "H"
ColumnTotal "I"
ColumnTotal "J"
ColumnTotal "K"

End Sub

Sub ColumnTotal(ByVal strColumn As String)
Cells(Rows.Count, strColumn).End(xlUp).Offset(2, 0).Value = _
Application.Sum(Columns(strColumn))
End Sub
 
C

Crystal

Hi Billy,

here is some code you can use as a reference:

This particular routine deletes a file that will be replaced
with a file containing current data in Excel format. The
source for this data is the name of any query (or table).

The program then goes on to open Excel, open a workbook
containing code to make a plot , then open the data for the
plot, then launch an Excel program called PlotData. You
could susbstitute your format macro here and specify the
personal.xls workbook.

If the user is left in Excel, the object variables are not
cleaned up -- set the UserControl property. Normally, you
would cleanup variables when done

' if Excel was opened using CreateObject rather the
GetObject (set a flag to determine which was used)
xlApp.quit

'release the object variable
set xlApp = nothing

Note: after the KILL command, rather than assuming Access
will see all the errors (because it may not, if the error
flag is raised by the network), it would be good idea to
also do a DoEvents and test for make sure a directory call
does not return the file

'------------------------------------------------------
dim mExcelFile as string, qName a string
mExcelFile = "c:\path\filename.xls"
qName = "QueryName or Tablename"

If Dir(mExcelFile) <> "" Then
On Error Resume Next
Kill mExcelFile
If Err.Number > 0 Then
'assume file is open
'~~~~~~~~~~~~~~~~~~~~~~ message to CLOSE the file
MsgBox "You must close " & mExcelFile & " in Excel " _
& " before Access can continue", , "Aborting Graph"
Exit Function
End If
On Error GoTo error_handler
DoEvents
End If

DoCmd.TransferSpreadsheet acExport, , qName, mExcelFile,
True

Dim xlApp As Excel.Application

'if Excel is already open, use that instance
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
On Error GoTo error_handler

'What did we find?...
If TypeName(xlApp) = "Nothing" Then
'Excel was not open -- create a new instance
Set xlApp = CreateObject("Excel.Application")
End If

xlApp.Visible = True
xlApp.UserControl = True

'this is the workbook with the code if you want to
launch an Excel Sub
xlApp.Workbooks.Open mPath & "PROGRAMS.XLS"

'this is the workbook to run code on, or just to open
xlApp.Workbooks.Open mExcelFile

'run Sub in Programs Workbook if applicable
xlApp.Run "PROGRAMS.XLS!ModuleName.SubName"

Exit Sub

error_handler:
msgbox err.description,,"ERROR " & err.number & "
error_handler"
'press F8 to step through lines of code to see where
problem is
Stop
Resume

'------------------------------------------------------

Have an awesome day

Warm Regards,
Crystal

MVP Microsoft Access
strive4peace2006 at yahoo.com
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top