code to display Excel range in Access Report

[HGood]

Hi, I asked this over in the Reports forum, but likely should have asked it
here...
I have code below which others here have kindly helped me to assemble. It
works great in the Form, where one project is in focus at a time. But I'd
like
now to design a Report so it will report on these same 4 ranges from
the spreadsheet, but all in one report. There are about 150 project
spreadsheets each with their unique EthID number as file name, so I'd like
the report to display these 4 ranges on one line per project. So the entire
report would be about 2 or 3 pages long.

I've tried adjusting the code below a bit and inserting it into the
OnActivate
Event of the Report. But I can't figure out how to make it work. It gets
hung up at the Me.ctrlEthID line.

Thanks very much for any help you can offer.
Haroldd
=======================================
Private Sub Form_Load()
Dim xlApp As Object ' Reference to Microsoft Excel.
Dim xlBook As Object 'Workbook Object
Dim xlSheet As Object 'Worksheet Object
Dim varRet As Variant
Set xlApp = CreateObject("excel.application")
Set xlBook = xlApp.Workbooks.Open("W:\Field Coordinators\!Plan &
Progress Spreadsheets\" & Me.ctrlEthID & ".xls.lnk", 0, True)
Me.Qtr = xlBook.Worksheets("Progress").Range("aa18")
Me.Yr = xlBook.Worksheets("Progress").Range("ab18")
'Me.Planned = xlBook.Worksheets("Progress").Range("ao40")
Me.Planned =
xlApp.WorksheetFunction.Sum(xlBook.Worksheets("Progress").Range("AL19:AL39"))
Me.Actual = xlBook.Worksheets("Progress").Range("ao40")
xlBook.Close SaveChanges:=False
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
End Sub

 

[HGood]

Hi, yes, ctrlEthID is on the report. I didn't know the Detail Print event
existed, but moving this code there seems to be moving me in the right
direction. Today I'm not at the office but running across a VPN and it seemed
to be processing for quite a while, then after about 40 seconds gave me a
message that it couldn't find 10239.xls spreadsheet. It turns out that not
all the projects as of yet have a spreadsheet.

Is there an If statement that I can include that, if a spreadsheet doesn't
exist, it will leave those ranges blank for that EthID and go on down the
rest of the list?

Thanks,
Harold

 

[Ralph]

You could use the Len and the Dir function to test if the file exists.
If Len(Dir(W:\Field Coordinators\!Plan Progress Spreadsheets\" &
Me.ctrlEthID & ".xls.lnk"))>0

You might want to look into Klatuu's suggestion as a long term solution.
Seems like a lot of overhead opening and closing all of those Excel files.

Good Luck!

 

[HGood]

Thanks for this. I realize it may take too long to run this report, but I
feel I'm so close to getting it running that I'd like to at least get this
going, even if it takes a few minutes to run the report. Going Klatuu's way I
have no idea how to do it. Even if I did, I guess I'd have to run it daily or
weekly to have fairly recent info for the report.

But for now I'd prefer to persevere with this method, I feel I'm so close.
Below is the code as I've tried to include your If statement. I don't know if
I've done it right, it gives an error message of "Bad File Name or Number".
I'm not sure what the Len is checking. The EthID does appear on the Report,
so if Len is checking that, then it will always be >0, so it seems that
method won't work. Is there a way to check if the opening of the spreadsheet
returns a value. I've seen something about using ShellExecute somewhere, that
returns a 2 if it doesn't open. Perhaps the If statement could be built
around this "2".

Any help you can offer with this If statement will be much appreciated.
Thanks, Harold

Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)

Dim xlApp As Object ' Reference to Microsoft Excel.
Dim xlBook As Object 'Workbook Object
Dim xlSheet As Object 'Worksheet Object
Dim varRet As Variant

Set xlApp = CreateObject("excel.application")
If Len(Dir("W:\Field Coordinators\!Plan Progress Spreadsheets\" &
Me.EthID & ".xls.lnk")) > 0 Then
Set xlBook = xlApp.Workbooks.Open("W:\Field Coordinators\!Plan &
Progress Spreadsheets\" & Me.EthID & ".xls.lnk", 0, True)
Me.Qtr = xlBook.Worksheets("Progress").Range("aa18")
Me.Yr = xlBook.Worksheets("Progress").Range("ab18")
Me.Planned =
xlApp.WorksheetFunction.Sum(xlBook.Worksheets("Progress").Range("AL19:AL39"))
Me.Actual = xlBook.Worksheets("Progress").Range("ao40")
xlBook.Close SaveChanges:=False
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
End If
End Sub
=====================================

 

[Ralph]

I may not have copied your workbook path correctly maybe this is better?

If Len(Dir("W:\Field Coordinators\!Plan & Progress Spreadsheets\" & Me.EthID
& ".xls.lnk"))>0 Then

Thanks, Ralph

 

[HGood]

Hi, I'm having trouble with the If statement, knowing where to place the
EndIf. I've tried it at different places, but none will work quite right. As
I've placed it in the code below, just above the End Sub, is that where it
should be? With it there, it does run, but the report, for each EthID,
displays identical results for each row.
Thanks, Harold

Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)

Dim xlApp As Object ' Reference to Microsoft Excel.
Dim xlBook As Object 'Workbook Object
Dim xlSheet As Object 'Worksheet Object
Dim varRet As Variant

Set xlApp = CreateObject("excel.application")
If Len(Dir("W:\Field Coordinators\!Plan Progress Spreadsheets\" &
Me.EthID & ".xls.lnk")) > 0 Then
Set xlBook = xlApp.Workbooks.Open("W:\Field Coordinators\!Plan &
Progress Spreadsheets\" & Me.EthID & ".xls.lnk", 0, True)
Me.Qtr = xlBook.Worksheets("Progress").Range("aa18")
Me.Yr = xlBook.Worksheets("Progress").Range("ab18")
Me.Planned =
xlApp.WorksheetFunction.Sum(xlBook.Worksheets("Progress").Range("AL19:AL39"))
Me.Actual = xlBook.Worksheets("Progress").Range("ao40")
xlBook.Close SaveChanges:=False
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
End If

End Sub

==================================

 

[Ralph]

You had it after xlApp.quit, so if it didn't find it Excel would quit. Hope
this helps

Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)

Dim xlApp As Object ' Reference to Microsoft Excel.
Dim xlBook As Object 'Workbook Object
Dim xlSheet As Object 'Worksheet Object
Dim varRet As Variant

Set xlApp = CreateObject("excel.application")
If Len(Dir("W:\Field Coordinators\!Plan Progress Spreadsheets\" &
Me.EthID & ".xls.lnk")) > 0 Then

Set xlBook = xlApp.Workbooks.Open("W:\Field Coordinators\!Plan &
Progress Spreadsheets\" & Me.EthID & ".xls.lnk", 0, True)
Me.Qtr = xlBook.Worksheets("Progress").Range("aa18")
Me.Yr = xlBook.Worksheets("Progress").Range("ab18")
Me.Planned =
xlApp.WorksheetFunction.Sum(xlBook.Worksheets("Progress").Range("AL19:AL39"))
Me.Actual = xlBook.Worksheets("Progress").Range("ao40")
xlBook.Close SaveChanges:=False
End If

xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing


End Sub

 

[HGood]

Hmmm...
It now runs all the way thru them, lists all the projects by EthID, but the
4 fields to the right, where the data should be are empty. So the Len seems
to be correctly weeding out the ones that don't exist, but it's not picking
up the data.

Any thoughts on that?
Again, many thanks, Harold

 

[HGood]

Hi, I have pasted below, the code I'm now trying to run. I get strange
results. For experimentation I have placed about 5 project spreadsheets and
their shortcuts on my C: drive (and limit my query to those 5). If I redirect
the code to go there, it works fine, and the If(Len statement correctly skips
over those that don't exist. However if I direct it then to go to the network
drive W, it doesn't work, in fact it doesn't even try to go to W drive. I
know this because if I rename one of the folders in the W path it doesn't
come up with an error. However, if I comment out the If EndIf statement and
direct it to the W drive, and limit my query to those spreadsheets that i
know exist, then it does work correctly. If I also rename that folder in the
path, it gives me an error message that it can't find the file.

So it seems that when directed to C drive, it works great, and the If
statement correctly skips those spreadsheets that don't exist. But when
directed to W drive, it is the If statement itself that prevents it from even
going to W drive. See code below.

I think we're so close, I'd sure appreciate if someone could help me see how
the IF statement needs to be tweaked so as to not prevent it going to W drive.

Many thanks, Harold

Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)
Dim xlApp As Object ' Reference to Microsoft Excel.
Dim xlBook As Object 'Workbook Object
Dim xlSheet As Object 'Worksheet Object
Dim varRet As Variant

Set xlApp = CreateObject("excel.application")
'If Len(Dir("W:\Field Coordinators\!Plan Progress Spreadsheets\" &
Me.EthID & ".xls.lnk")) > 0 Then
If Len(Dir("C:\Documents and Settings\goodh\My
Documents\!tmp2\Projects\" & Me.EthID & ".xls.lnk")) > 0 Then
'Set xlBook = xlApp.Workbooks.Open("W:\Field Coordinators\!Plan &
Progress Spreadsheets\" & Me.EthID & ".xls.lnk", 0, True)
Set xlBook = xlApp.Workbooks.Open("C:\Documents and Settings\goodh\My
Documents\!tmp2\Projects\" & Me.EthID & ".xls.lnk", 0, True)
Me.Qtr = xlBook.Worksheets("Progress").Range("aa18")
Me.Yr = xlBook.Worksheets("Progress").Range("ab18")
Me.Planned =
xlApp.WorksheetFunction.Sum(xlBook.Worksheets("Progress").Range("AL19:AL39"))
Me.Actual = xlBook.Worksheets("Progress").Range("ao40")
xlBook.Close SaveChanges:=False
End If
xlApp.Quit
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
=======================================

 

[HGood]

Oops! I discovered I left out the "&" from one of the paths for W, that's why
it didn't work. Now it works great! Thanks so much Ralph.

Harold
====================