Control created excel workbook using access VBA

[Tadynn]

Access 2k

I haven't yet seen anything really good on this question so I thought that I'd pose it myself.

I create a lot of queries as excel spreadsheets because they are far easier to sork with for clients etc and unfortunately, not everyone has access.

A write a lot of little functions similar to the snippet shown below for querying a table for information and copying all that information to a temp table and then I export the contents of the table to an excel spreadsheet.

Private Sub DailyItmsDisp_Click()
A = "SELECT tbl_RMADetails.DispatchDate, tbl_RMADetails.Part, tbl_RMADetails.Serial, " & _
"tbl_RMADetails.CtnID INTO tmp_DailyItemsDisp " & _
"FROM tbl_RMADetails " & _
"WHERE (((tbl_RMADetails.DispatchDate) Between " & _
"[Forms]![frm_ItemsDispatched]![DailyItemsDisp] And " & _
"[Forms]![frm_ItemsDispatched]![DailyItemsDisp] & ' 23:59') AND " & _
"((tbl_RMADetails.Flag)='6')) " & _
"ORDER BY tbl_RMADetails.Part"
DoCmd.SetWarnings False
DoCmd.RunSQL A

DoCmd.OutputTo acTable, "tmp_DailyItemsDisp", "MicrosoftExcel(*.xls)", "", True, ""

DoCmd.SetWarnings True


Step two, once the file is created. Is to run a macro in that I've created in excel to format the spreadsheet in terms of presentation. Below is the VBA code behind the macro in excel that I run.

Sub Format_weekly_dispatch()
'
' Format_weekly_dispatch Macro
' Macro recorded 28/09/2004 by Daemynn Walker
'

'
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "Weekly Dispatches"
Range("A1").Select
With Selection.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Selection.Font.Bold = True
Range("A4:C4").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone
Selection.Font.Bold = True
Columns("A:C").Select
Selection.ColumnWidth = 20.29
Range("A4:C4").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Rows("3:3").Select
Selection.Insert Shift:=xlDown
Range("A3").Select
ActiveCell.FormulaR1C1 = "Date:"
Range("A3").Select
Selection.Font.Bold = True
Range("B3").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("B3").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("A5:C5").Select
With ActiveSheet.PageSetup
.PrintTitleRows = "$5:$5"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "Page &P of &N"
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.748031496062992)
.RightMargin = Application.InchesToPoints(0.748031496062992)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
End With
Range("A10").Select
End Sub

Is there a way to bridge both these two pieces of code so that I creating and export data into excel and then format the spreadsheet all at the press of a button?

I don't really want to use templates because my database is often sent through to other people to use. I find it enough of a hassle just getting the macro set up on their PC's alone.

This must have been done before, can anyone help me by telling me what code I should include between the 2 bits of code to join the whole lot together?

Rgrds Tadynn

 

[KenReay]

Hi

Having created the spread sheet with your line
DoCmd.OutputTo acTable, "tmp_DailyItemsDisp", "MicrosoftExcel(*.xls)", "", True, ""


you could open an instance of Excel from within access, open the file you have just created and execute the code you have now in your macro as Access VBA code acting on the the Excel opbject you haev created in Access/VBA, if you keep the instance of Excel invisible the user would see nothing, or you can if you prefer make it visible nad see the chanegs going on

Regards

Ken Reay
Freelance Solutions Developer
Boldon Information Systems Ltd
Website needs upgrading, but for now -

http://www.kenneth.reay.btinternet.co.uk

UK

 

[Molby]

Here's a bit of code that I use to do as Ken suggests:

Sub test()
Set acapp = CreateObject("Excel.Application")
acapp.Visible = True
Const Bookname = "C:\Test.xls"
acapp.Workbooks.Open (Bookname)
acapp.Run ("Format")
End Sub

 

[TriscuiT]

Or, you could create a macro within the Excel workbook and execute it from Access.

Microsoft Knowledge Base Article - 194611
How To Create and Call an Excel Macro Programmatically from VB

http://support.microsoft.com/default.aspx?scid=kb;EN-US;194611

 

[Tadynn]

Hi there,

Thanks very much for your replies and I apologise for not replying sooner.

I successfully figured out how to run my code through access by writing the following code (thanks to Molby as I referenced what you had written to develop it.) I still am having a few problems though. I get an error message in my code just as I start to modify the excel spreadsheet.

The error message is errror: 92 'Variable or with block not set'. This has got something to do with the exapp variable that I have set, but I am looking for ways to define it more so that my code does not get confused.

Sometimes I can get the code to work if I step through it.

The other problem that I am having is now I am exporting two data sources into one workbook on separate sheets. How would I be able to modify my code to also format the second sheet as well?


Private Sub Command0_Click()
On Error GoTo Err_ExpWeekly

Dim exApp As Excel.Application, newSheet As Worksheet
Set exApp = CreateObject("Excel.Application")
ExpPath = Me.FilePath.Value

'Get all items currently awaiting dispatch
A = "SELECT tbl_RMADetails.RMA, tbl_RMADetails.Part, tbl_RMADetails.Serial, " & _
"tbl_RMADetails.Qty, tbl_RMADetails.Status, tbl_RMADetails.CtnID, " & _
"tbl_RMADetails.Comments INTO tmp_ItemsAwaitingDispatch " & _
"FROM tbl_RMADetails " & _
"WHERE (((tbl_RMADetails.Flag)='4'))"

'Get all items that have been dispatched today
B = "SELECT tbl_RMADetails.RMA, tbl_RMADetails.Part, tbl_RMADetails.Serial, " & _
"tbl_RMADetails.Qty, tbl_RMADetails.Status, tbl_RMADetails.CtnID, " & _
"tbl_RMADetails.Comments, tbl_RMADetails.DispatchDate INTO tmp_ItemsDispatchedToday " & _
"FROM tbl_RMADetails " & _
"WHERE (((tbl_RMADetails.DispatchDate) Between Date() And Now()) AND " & _
"((tbl_RMADetails.Flag)='6'))"

DoCmd.SetWarnings False
DoCmd.RunSQL A
DoCmd.RunSQL B

DoCmd.OutputTo acTable, "tmp_ItemsAwaitingDispatch", "MicrosoftExcel(*.xls)", ExpPath & "SOH_Inventory.xls", True, ""
DoCmd.OutputTo acTable, "tmp_ItemsDispatchedToday", "MicrosoftExcel(*.xls)", ExpPath & "Dispatched_today.xls", True, ""

exApp.Workbooks.Open ExpPath & "SOH_Inventory.xls"
exApp.Workbooks.Open ExpPath & "Dispatched_today.xls"
exApp.Workbooks(2).Worksheets(1).Copy after:=exApp.Workbooks(1).Worksheets(1)
exApp.Workbooks(1).Close SaveChanges:=False
exApp.Workbooks.Close
exApp.Workbooks.Open ExpPath & "SOH_Inventory.xls"
exApp.Rows("1:1").Select
Selection.Insert Shift:=xlDown '<---- This line occasionally fails error is err Number: 92 object block or with variable is not set
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "Weekly Dispatches"
Range("A1").Select
With Selection.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Selection.Font.Bold = True
Range("A4:G4").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Interior.ColorIndex = xlNone
Selection.Font.Bold = True
Columns("A:C").Select
Selection.ColumnWidth = 15.29
Columns("D:F").Select
Selection.ColumnWidth = 8
Columns("G").Select
Selection.ColumnWidth = 20.59
Range("A4:G4").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Rows("3:3").Select
Selection.Insert Shift:=xlDown
Range("A3").Select
ActiveCell.FormulaR1C1 = "Date:"
Range("A3").Select
Selection.Font.Bold = True
Range("B3").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("B3").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("A5:G5").Select
With ActiveSheet.PageSetup
.PrintTitleRows = "$5:$5"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "Page &P of &N"
.RightFooter = ""
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
End With
Range("A10").Select


Set exApp = Nothing
Kill ExpPath & "Dispatched_today.xls"

DoCmd.SetWarnings True
DoCmd.Close acForm, "frm_WeeklyDispatches"

Exit_ExpWeekly:
Exit Sub
Err_ExpWeekly:
MsgBox Err.Number & vbCrLf & Err.Description
Resume Exit_ExpWeekly



End Sub


Rgrds, tadynn

 

[Molby]

Tadynn,

I think your error message may come about due to the fact that you have not specified a Worksheet to perform the insert rows on.

As to looping through each work book, try playing around a for next statement along the lines of

Sub Test()
bknam$ = exApp.Workbooks.Open ExpPath & "SOH_Inventory.xls"
Dim ws As Worksheet
For Each ws In bknam$.Worksheets
  Your code in here
Next ws
End Sub

 

[RoyVidar]

These types of errors, where it doesn't "make much sence" where the error occurs, is most commonly a result of using unqualified references to Excel objects, methods and properties. The first one occurs in the declaration:

[tt]... newSheet As Excel.Worksheet[/tt]

The recommandation from Microsoft, is to fully qualify all references to objects, methods and properties. Any implicit reference will most probably cause failure to run the second time, an extra instance of Excel in memory (check Task Manager), and other peculiarities.

To give a brief start, I'd recommend using a workbook object, and assign the newly opened workbook to, then use that to assig the worksheet object:

[tt]dim exWr as Excel.Workbook
dim exWr2 as Excel.Workbook
...
set exWr = exApp.Workbooks.Open(ExpPath & "SOH_Inventory.xls")
set exWr2 = exApp.Workbooks.Open(ExpPath & "Dispatched_today.xls")
...
set newSheet = exWr.worksheets(1) ' or exWr2?
newsheet.activate
newSheet.range("a1").select
exApp.selection.insert shift:=xldown
...[/tt]

Basically, all your referencing is implicit (selection, range, activecell...), and will need to be explicit. Here's a couple of recent threads dealing with the same, some containing links to Microsoft pages with some explanations thread705-925610, thread705-901245.

Roy-Vidar