Automate Excel-Based Report 3

[MwTV]

Assistance needed for task that I am not able to quite handle!

Trying to automate daily MS Excel-based Report using an Excel template that is based on a query of an external data source that is set to refresh automatically.

How should the following code be modified if I want to perform the following upon opening the Excel template;

* Automate pages setup (columns will always be "A" to "Q" but the number of records will vary);

* Populate cell A2 with today's date;

* Delete all macros (prior to distribution);

* Save to local folder with a filename that is appended with today's date. For example, "C:\Reports\ClientReport_Today'sDate.xls"

* and E-mail to manager (Jane Smith) via MS Outlook and cc Supervisor, John Smith.


So far, I have the following code.

Any insight to point me in the right direction is greatly appreciated!

Sub PageSetup()
Dim ws As Worksheet
Set ws = ActiveSheet
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
With ws.PageSetup
.Orientation = xlLandscape
.Zoom = False ' Force to use fit to page
.FitToPagesWide = 1
.FitToPagesTall = 1
'Do not print the grid lines on the printout
.PrintGridlines = False

'Set left margin to 0.25 inches
.LeftMargin = Application.InchesToPoints(0.25)
'Set right margin to 0.25 inches
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.PaperSize = xlPaperA4
'Print the first 3 rows as the header on each sheet
.PrintTitleRows = appXl.ActiveSheet.Range("A1:A4").Address
.PrintArea = "$A$1:$Q25$"

End With
With Application
.Calculation = xlCalculationAutomatic
.Calculate 'Force Excel to calculate the workbook.
.ScreenUpdating = True
End With
ws.PrintOut
End Sub

 

[SkipVought]

* Automate pages setup (columns will always be "A" to "Q" but the number of records will vary);

If this is a QUERY, all you have to do is Data > Refresh.

* Populate cell A2 with today's date;

=today()

* Delete all macros (prior to distribution);

Copy report sheet to a new workbook

* Save to local folder with a filename that is appended with today's date. For example, "C:\Reports\ClientReport_Today'sDate.xls"

SaveAs "C:\Reports\ClientReport_" & Format(Date,"yyyymmdd") & ".xls"

* and E-mail to manager (Jane Smith) via MS Outlook and cc Supervisor, John Smith.

Check out Sendmail



Skip,
[sub]
When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[/sub]

 

[MwTV]

Any VBA options that would perform the desired actions?

Specifically, can the actions be performed only if there is data retrieved from the query?

Thank you.

 

[SkipVought]

You can test to see if there are nore than 3 rows in the QueryTable range. Could even be a simple COUNTA sheet function.

Skip,
[sub]
When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[/sub]

 

[PHV]

You may test the value of this property:
Activesheet.QueryTables(1).ResultRange.Rows.Count

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[MwTV]

Currently, still having issues with modifying the code below.

Upon opening the Excel template, the data is populated.

Then, upon clicking Tools/Macro/"Set Page Setup"

there is an error - "Unable to set the Print Area property of the PageSetup class."

Sub PageSetup()
Dim ws As Worksheet
Set ws = ActiveSheet
'Determine if any data from query
If ActiveSheet.QueryTables(1).ResultRange.Rows.Count > 3 Then
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
With ws.PageSetup
.Orientation = xlLandscape
.Zoom = False ' Force to use fit to page
.FitToPagesWide = 1
.FitToPagesTall = 1
'Do not print the grid lines on the printout
.PrintGridlines = False

'Set left margin to 0.25 inches
.LeftMargin = Application.InchesToPoints(0.25)
'Set right margin to 0.25 inches
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.PaperSize = xlPaperA4
'Print the first 3 rows as the header on each sheet
'.PrintTitleRows = appXl.ActiveSheet.Range("A1:A4").Address Original
.PrintTitleRows = Application.ActiveSheet.Range("A1:A4").Address
.PrintArea = "$A$5:$Q25$"

End With
With Application
.Calculation = xlCalculationAutomatic
.Calculate 'Force Excel to calculate the workbook.
.ScreenUpdating = True
End With
ws.PrintOut

Else
MsgBox ("No Data")
End If
End Sub

 

[SkipVought]

Hi,

1, You cannot use PageSetup as a Procedure Name as it is a RESERVE WORD.

2. The ADDRESS of the PrintArea is an incorrect syntax.

Sub PageSetup[b]A[/b]()
  Dim ws As Worksheet
  Set ws = ActiveSheet
'Determine if any data from query
    If ws.QueryTables(1).ResultRange.Rows.Count > 3 Then
      With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
      End With
      With ws.PageSetup
        .Orientation = xlLandscape
        .Zoom = False ' Force to use fit to page
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    'Do not print the grid lines on the printout
        .PrintGridlines = False
        
    'Set left margin to 0.25 inches
        .LeftMargin = Application.InchesToPoints(0.25)
    'Set right margin to 0.25 inches
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(1)
        .PaperSize = xlPaperA4
    'Print the first 3 rows as the header on each sheet
        '.PrintTitleRows = appXl.ActiveSheet.Range("A1:A4").Address  Original
        .PrintTitleRows = Application.ActiveSheet.Range("A1:A4").Address
        .PrintArea = "$A$5:[b]$Q$25[/b]"
      
      End With
      With Application
        .Calculation = xlCalculationAutomatic
        .Calculate  'Force Excel to calculate the workbook.
        .ScreenUpdating = True
      End With
      ws.PrintOut
    
    Else
    MsgBox ("No Data")
    End If
End Sub

Skip,
[sub]
When a diminutive clarvoyant had disappeared from detention, headlines read...
Small Medium at Large[/sub]