External Data Link in Excel

[M. Bader]

I've written a VB6 Program backended with Access 2000. My
client want's one of the reports to be a pivot table that
she can also save using the save as. The problem is that
when I save the spreadsheet, it doesn't save the
information as to where the data is. Does anyone know how
to do this? Thanks in advanced. You can e-mail me at
(e-mail address removed) if you like.

VB6 Code...................................................

Public Sub ProjectsByPost()
On Error GoTo Proc_Err

Dim iRow As Integer

Set rsRpts = New ADODB.Recordset
Set rsProposals = New ADODB.Recordset

strSQL = "SHAPE {SELECT [FiscalYear],[Post],[Prj_ID],
[Project],[Tot_Accepted],[Tot_Proposed],[VE_Stdy_Cost]
FROM [tbl_Projects] } APPEND ({SELECT [Prj_ID],
[Tot_Proposed_Savings] FROM [tbl_Proposals] } RELATE
[Prj_ID] TO [Prj_ID] ) AS Proposals"

rsRpts.StayInSync = True
rsRpts.Open strSQL, conRpts, adOpenForwardOnly,
adLockReadOnly
Set rsProposals = rsRpts("Proposals").Value

If Not rsRpts.BOF And Not rsRpts.EOF Then

iRow = 0
ReDim arrData(rsRpts.RecordCount + 1, 6)

'Add Column Headers
arrData(iRow, 0) = "Fiscal Year"
arrData(iRow, 1) = "Post"
arrData(iRow, 2) = "Nbr. Studies"
arrData(iRow, 3) = "Proposed Cost Savings"
arrData(iRow, 4) = "VE Study Cost"
arrData(iRow, 5) = "Accepted\Proposed"
arrData(iRow, 6) = "ROI"

Do Until rsRpts.EOF

iRow = iRow + 1

If Not rsProposals.BOF And Not rsProposals.EOF
Then
Do Until rsProposals.EOF
arrData(iRow, 3) = arrData(iRow, 3) +
rsProposals!Tot_Proposed_Savings
rsProposals.MoveNext
Loop
End If

arrData(iRow, 0) = rsRpts!FiscalYear
arrData(iRow, 1) = rsRpts!Post
arrData(iRow, 2) = rsProposals.RecordCount
arrData(iRow, 4) = rsRpts!VE_Stdy_Cost
If NoValue(rsRpts!Tot_Accepted) = False And
NoValue(arrData(iRow, 3)) = False Then
arrData(iRow, 5) = rsRpts!Tot_Accepted /
arrData(iRow, 3)
End If
If NoValue(rsRpts!Tot_Accepted) = False And
NoValue(arrData(iRow, 4)) = False Then
arrData(iRow, 6) = rsRpts!Tot_Accepted /
arrData(iRow, 4)
End If

rsRpts.MoveNext

Loop

End If

Call DumpToExcel(iRow, 6)

Proc_Exit:
Erase arrData
If rsRpts.State = adStateOpen Then
rsRpts.Close
Set rsRpts = Nothing
End If
Exit Sub

Proc_Err:
MsgBox "Error #" & Err.Number & vbNewLine &
Err.Description, vbInformation, "Module: ProjectsByPost"
Resume Proc_Exit

End Sub

 

[Graeme Whelan]

I think I know what you're trying to do, but could you include ALL the
variable declarations you're using with the VB6 code (and perhaps the
code for the DumpToExcel function? (I assume you've set OPTION
EXPLICIT). It's hard to find out why your data source isn't being saved
without an indication of HOW you're saving the workbook - you may have
already tried what's being suggested, and a lot better than what's below:

In case it helps, have you considered something like (in excel terms),
the following in your 'DumpToExcel' function??
....................
Dim SaveSQL as String
Save SQL = "<insert SQL string here>"
ActiveWorkbook.Range("A65536").Value = SaveSQL
....................

Then modify (if required) the VB6 code to look for that cell and use the
SQL from there:
....................
If ActiveWorkbook.Range("A65536").Value <> "" Then
strSQL = ActiveWorkbook.Range("A65536").Value
End If
....................
I hope this helps, if not, perhaps you could help me with some of my code!!!

I've written a VB6 Program backended with Access 2000. My
client want's one of the reports to be a pivot table that
she can also save using the save as. The problem is that
when I save the spreadsheet, it doesn't save the
information as to where the data is. Does anyone know how
to do this? Thanks in advanced. You can e-mail me at
(e-mail address removed) if you like.

VB6 Code...................................................

Public Sub ProjectsByPost()
On Error GoTo Proc_Err

Dim iRow As Integer

Set rsRpts = New ADODB.Recordset
Set rsProposals = New ADODB.Recordset

strSQL = "SHAPE {SELECT [FiscalYear],[Post],[Prj_ID],
[Project],[Tot_Accepted],[Tot_Proposed],[VE_Stdy_Cost]
FROM [tbl_Projects] } APPEND ({SELECT [Prj_ID],
[Tot_Proposed_Savings] FROM [tbl_Proposals] } RELATE
[Prj_ID] TO [Prj_ID] ) AS Proposals"

rsRpts.StayInSync = True
rsRpts.Open strSQL, conRpts, adOpenForwardOnly,
adLockReadOnly
Set rsProposals = rsRpts("Proposals").Value

If Not rsRpts.BOF And Not rsRpts.EOF Then

iRow = 0
ReDim arrData(rsRpts.RecordCount + 1, 6)

'Add Column Headers
arrData(iRow, 0) = "Fiscal Year"
arrData(iRow, 1) = "Post"
arrData(iRow, 2) = "Nbr. Studies"
arrData(iRow, 3) = "Proposed Cost Savings"
arrData(iRow, 4) = "VE Study Cost"
arrData(iRow, 5) = "Accepted\Proposed"
arrData(iRow, 6) = "ROI"

Do Until rsRpts.EOF

iRow = iRow + 1

If Not rsProposals.BOF And Not rsProposals.EOF
Then
Do Until rsProposals.EOF
arrData(iRow, 3) = arrData(iRow, 3) +
rsProposals!Tot_Proposed_Savings
rsProposals.MoveNext
Loop
End If

arrData(iRow, 0) = rsRpts!FiscalYear
arrData(iRow, 1) = rsRpts!Post
arrData(iRow, 2) = rsProposals.RecordCount
arrData(iRow, 4) = rsRpts!VE_Stdy_Cost
If NoValue(rsRpts!Tot_Accepted) = False And
NoValue(arrData(iRow, 3)) = False Then
arrData(iRow, 5) = rsRpts!Tot_Accepted /
arrData(iRow, 3)
End If
If NoValue(rsRpts!Tot_Accepted) = False And
NoValue(arrData(iRow, 4)) = False Then
arrData(iRow, 6) = rsRpts!Tot_Accepted /
arrData(iRow, 4)
End If

rsRpts.MoveNext

Loop

End If

Call DumpToExcel(iRow, 6)

Proc_Exit:
Erase arrData
If rsRpts.State = adStateOpen Then
rsRpts.Close
Set rsRpts = Nothing
End If
Exit Sub

Proc_Err:
MsgBox "Error #" & Err.Number & vbNewLine &
Err.Description, vbInformation, "Module: ProjectsByPost"
Resume Proc_Exit

End Sub