Two Q's: Trouble Closing Excel & run-Time 462

  • Thread starter Thread starter Austin
  • Start date Start date
A

Austin

Hi, I am running the code below and two questions coming up:

a) There is still an instance of Excel running in my processes once it is
complete
b) Every other time I run it, I get run-time 462 'The remote server machine
does not exist or is unavailable'

If you can help me out I would really appreciate it, thanks a lot.

Option Explicit

Private Sub Command1_Click()
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlWorkbook As Excel.Workbook
Dim strDate As Date
Dim xlThreeMo As Excel.Range
Dim xlOneYr As Excel.Range
Dim xlThreeYr As Excel.Range
Dim xlFiveYr As Excel.Range
Dim xlTenYr As Excel.Range
Dim xlrng2 As Excel.Range
Dim xlDate As Excel.Range
Dim objRST As Recordset
Dim intnumber As Integer
Dim strQuery As String
Dim strSheetName As String

'Queries the data
strQuery = "TRANSFORM Sum([Month Value.return]+1) As Return " & _
"SELECT Fund.Fund " & _
"From Dates, Fund INNER JOIN [Month Value] ON Fund.[Fund ID] =
[Month Value].[Fund ID] " & _
"WHERE (((IIF([Month Value.End Date]>[Dates.Ten Year] AND " & _
"[Month Value.End Date]<=[Dates.This Month],1,0))=1)) " & _
"GROUP BY Fund.Fund " & _
"PIVOT [Month Value].[End Date];"
strSheetName = Left(strQuery, 10)
strSheetName = Trim(strSheetName)

'Creates the worksheet
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set xlWorkbook = xlApp.Workbooks.Add
Set objRST = Application.CurrentDb.OpenRecordset(strQuery)

strDate = Me.Text2.Value

With objRST
If Not .EOF Then .MoveLast
intnumber = objRST.RecordCount
.MoveFirst
End With

Set xlSheet = xlWorkbook.Sheets(1)

With xlSheet
.Range("A2").CopyFromRecordset objRST
.Name = strSheetName
End With

With xlSheet
Set xlThreeMo = xlSheet.Range(.Cells(2, 123), .Cells(intnumber + 1, 123))
Set xlOneYr = xlSheet.Range(.Cells(2, 124), .Cells(intnumber + 1, 124))
Set xlThreeYr = xlSheet.Range(.Cells(2, 125), .Cells(intnumber + 1, 125))
Set xlFiveYr = xlSheet.Range(.Cells(2, 126), .Cells(intnumber + 1, 126))
Set xlTenYr = xlSheet.Range(.Cells(2, 127), .Cells(intnumber + 1, 127))
End With


xlThreeMo.FormulaR1C1 =
"=IF(Countblank((RC[-4]:RC[-2]))>0,-500,Product(RC[-4]:RC[-2])-1)"
xlOneYr.FormulaR1C1 =
"=IF(Countblank((RC[-14]:RC[-3]))>0,-500,Product(RC[-14]:RC[-3])-1)"
xlThreeYr.FormulaR1C1 =
"=IF(Countblank((RC[-39]:RC[-4]))>0,-500,Product(RC[-39]:RC[-4])^(1/3)-1)"
xlFiveYr.FormulaR1C1 =
"=IF(Countblank((RC[-64]:RC[-5]))>0,-500,Product(RC[-64]:RC[-5])^(1/5)-1)"
xlTenYr.FormulaR1C1 =
"=IF(countblank((RC[-125]:RC[-6]))>0,-500,Product(RC[-125]:RC[-6])^(1/10)-1)"


With xlSheet
.Range("A1:ZZ5000").Select
.Range("A1:ZZ5000").Copy
.Range("A1:ZZ5000").Activate
.Range("A1:ZZ5000").PasteSpecial (xlPasteValues)
End With

With xlSheet
.Columns("B:DQ").Select
.Columns("B:DQ").Delete Shift:=xlToLeft
End With

With xlSheet
Set xlDate = xlSheet.Range(.Cells(2, 2), .Cells(intnumber + 1, 2))
End With

xlDate.Value = strDate

With xlSheet
Range("A1").Select
ActiveCell.FormulaR1C1 = "fund"
Range("B1").Select
ActiveCell.FormulaR1C1 = "End Date"
Range("C1").Select
ActiveCell.FormulaR1C1 = "3Mo"
Range("D1").Select
ActiveCell.FormulaR1C1 = "1Yr"
Range("E1").Select
ActiveCell.FormulaR1C1 = "3Yr"
Range("F1").Select
ActiveCell.FormulaR1C1 = "5Yr"
Range("G1").Select
ActiveCell.FormulaR1C1 = "10Yr"
End With

With xlApp
Excel.Application.DisplayAlerts = False
.Workbooks(1).SaveAs "C:\Users\Austin Meier\Desktop\File1.xlsx"
.Quit
End With

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Output
Table", _
"c:\Users\Austin Meier\Desktop\File1.xlsx", True

Set xlApp = Nothing
Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlThreeMo = Nothing
Set xlOneYr = Nothing
Set xlThreeYr = Nothing
Set xlFiveYr = Nothing
Set xlTenYr = Nothing
Set xlrng2 = Nothing
Set xlDate = Nothing
Set objRST = Nothing
End Sub
 
Austin said:
Hi, I am running the code below and two questions coming up:

a) There is still an instance of Excel running in my processes once
it is complete
b) Every other time I run it, I get run-time 462 'The remote server
machine does not exist or is unavailable'

If you can help me out I would really appreciate it, thanks a lot.

Option Explicit

Private Sub Command1_Click()
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlWorkbook As Excel.Workbook
Dim strDate As Date
Dim xlThreeMo As Excel.Range
Dim xlOneYr As Excel.Range
Dim xlThreeYr As Excel.Range
Dim xlFiveYr As Excel.Range
Dim xlTenYr As Excel.Range
Dim xlrng2 As Excel.Range
Dim xlDate As Excel.Range
Dim objRST As Recordset
Dim intnumber As Integer
Dim strQuery As String
Dim strSheetName As String

'Queries the data
strQuery = "TRANSFORM Sum([Month Value.return]+1) As Return " & _
"SELECT Fund.Fund " & _
"From Dates, Fund INNER JOIN [Month Value] ON Fund.[Fund
ID] = [Month Value].[Fund ID] " & _
"WHERE (((IIF([Month Value.End Date]>[Dates.Ten Year] AND
" & _ "[Month Value.End Date]<=[Dates.This
Month],1,0))=1)) " & _ "GROUP BY Fund.Fund " & _
"PIVOT [Month Value].[End Date];"
strSheetName = Left(strQuery, 10)
strSheetName = Trim(strSheetName)

'Creates the worksheet
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set xlWorkbook = xlApp.Workbooks.Add
Set objRST = Application.CurrentDb.OpenRecordset(strQuery)

strDate = Me.Text2.Value

With objRST
If Not .EOF Then .MoveLast
intnumber = objRST.RecordCount
.MoveFirst
End With

Set xlSheet = xlWorkbook.Sheets(1)

With xlSheet
.Range("A2").CopyFromRecordset objRST
.Name = strSheetName
End With

With xlSheet
Set xlThreeMo = xlSheet.Range(.Cells(2, 123), .Cells(intnumber +
1, 123)) Set xlOneYr = xlSheet.Range(.Cells(2, 124),
.Cells(intnumber + 1, 124)) Set xlThreeYr =
xlSheet.Range(.Cells(2, 125), .Cells(intnumber + 1, 125)) Set
xlFiveYr = xlSheet.Range(.Cells(2, 126), .Cells(intnumber + 1, 126))
Set xlTenYr = xlSheet.Range(.Cells(2, 127), .Cells(intnumber + 1,
127)) End With


xlThreeMo.FormulaR1C1 =
"=IF(Countblank((RC[-4]:RC[-2]))>0,-500,Product(RC[-4]:RC[-2])-1)"
xlOneYr.FormulaR1C1 =
"=IF(Countblank((RC[-14]:RC[-3]))>0,-500,Product(RC[-14]:RC[-3])-1)"
xlThreeYr.FormulaR1C1 =
"=IF(Countblank((RC[-39]:RC[-4]))>0,-500,Product(RC[-39]:RC[-4])^(1/3)-1)"
xlFiveYr.FormulaR1C1 =
"=IF(Countblank((RC[-64]:RC[-5]))>0,-500,Product(RC[-64]:RC[-5])^(1/5)-1)"
xlTenYr.FormulaR1C1 =
"=IF(countblank((RC[-125]:RC[-6]))>0,-500,Product(RC[-125]:RC[-6])^(1/10)-1)"


With xlSheet
.Range("A1:ZZ5000").Select
.Range("A1:ZZ5000").Copy
.Range("A1:ZZ5000").Activate
.Range("A1:ZZ5000").PasteSpecial (xlPasteValues)
End With

With xlSheet
.Columns("B:DQ").Select
.Columns("B:DQ").Delete Shift:=xlToLeft
End With

With xlSheet
Set xlDate = xlSheet.Range(.Cells(2, 2), .Cells(intnumber + 1, 2))
End With

xlDate.Value = strDate

With xlSheet
Range("A1").Select
ActiveCell.FormulaR1C1 = "fund"
Range("B1").Select
ActiveCell.FormulaR1C1 = "End Date"
Range("C1").Select
ActiveCell.FormulaR1C1 = "3Mo"
Range("D1").Select
ActiveCell.FormulaR1C1 = "1Yr"
Range("E1").Select
ActiveCell.FormulaR1C1 = "3Yr"
Range("F1").Select
ActiveCell.FormulaR1C1 = "5Yr"
Range("G1").Select
ActiveCell.FormulaR1C1 = "10Yr"
End With

With xlApp
Excel.Application.DisplayAlerts = False
.Workbooks(1).SaveAs "C:\Users\Austin Meier\Desktop\File1.xlsx"
.Quit
End With

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Output
Table", _
"c:\Users\Austin Meier\Desktop\File1.xlsx", True

Set xlApp = Nothing
Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlThreeMo = Nothing
Set xlOneYr = Nothing
Set xlThreeYr = Nothing
Set xlFiveYr = Nothing
Set xlTenYr = Nothing
Set xlrng2 = Nothing
Set xlDate = Nothing
Set objRST = Nothing
End Sub
Click to expand...

It's this

With xlSheet
Range("A1").Select
ActiveCell.FormulaR1C1 = "fund"
Range("B1").Select
ActiveCell.FormulaR1C1 = "End Date"
Range("C1").Select
ActiveCell.FormulaR1C1 = "3Mo"
Range("D1").Select
ActiveCell.FormulaR1C1 = "1Yr"
Range("E1").Select
ActiveCell.FormulaR1C1 = "3Yr"
Range("F1").Select
ActiveCell.FormulaR1C1 = "5Yr"
Range("G1").Select
ActiveCell.FormulaR1C1 = "10Yr"
End With

That you need to replace with something like

With xlSheet
.Range("A1").Value = "fund"
.Range("B1").Value = "End Date"
....

i e
1 - "anchor" it in a parent object (the actual problem)
2 - avoid selects (performance)

Also here

With xlApp
Excel.Application.DisplayAlerts = False
.Workbooks(1).SaveAs "C:\Users\Austin Meier\Desktop\File1.xlsx"
.Quit
End With

Rather do

xlApp.DisplayAlerts = False
xlWorkbook.SaveAs "C:\Users\Austin Meier\Desktop\File1.xlsx"
xlWorkbook.Close
set xlWorkbook = nothing
xlApp.Quit
Set xlApp = nothing

See http://support.microsoft.com/default.aspx?kbid=178510 for more
info
 
Thanks Roy -

I implemented the changes that you provided below but it still doesnt look
like it is killing the excel process. Also, the 462 error is still occuring.
I have made several changes, here is the updated code:

Option Compare Database

Private Sub Command0_Click()
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlWorkbook As Excel.Workbook
Dim strDate As Date
Dim intMonth As Integer
Dim xlThreeMo As Excel.Range
Dim xlOneYr As Excel.Range
Dim xlThreeYr As Excel.Range
Dim xlFiveYr As Excel.Range
Dim xlTenYr As Excel.Range
Dim xlrng2 As Excel.Range
Dim xlDate As Excel.Range
Dim objRST As Recordset
Dim intnumber As Integer
Dim strQuery As String
Dim strSheetName As String

'Queries the data
strQuery = "TRANSFORM Sum([Month Value.return]+1) As Return " & _
"SELECT Fund.Fund " & _
"From Dates, Fund INNER JOIN [Month Value] ON Fund.[Fund ID] =
[Month Value].[Fund ID] " & _
"WHERE (((IIF([Month Value.End Date]>[Dates.Ten Year] AND " & _
"[Month Value.End Date]<=[Dates.This Month],1,0))=1)) " & _
"GROUP BY Fund.Fund " & _
"PIVOT [Month Value].[End Date];"
strSheetName = Left(strQuery, 10)
strSheetName = Trim(strSheetName)

'Creates the worksheet
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set xlWorkbook = xlApp.Workbooks.Add
Set objRST = Application.CurrentDb.OpenRecordset(strQuery)

strDate = Me.Text2.Value

With objRST
If Not .EOF Then .MoveLast
intnumber = objRST.RecordCount
.MoveFirst
End With

Set xlSheet = xlWorkbook.Sheets(1)

With xlSheet
.Range("A2").CopyFromRecordset objRST
.Name = strSheetName
End With

With xlSheet
Set xlThreeMo = xlSheet.Range(.Cells(2, 123), .Cells(intnumber + 1, 123))
Set xlOneYr = xlSheet.Range(.Cells(2, 124), .Cells(intnumber + 1, 124))
Set xlThreeYr = xlSheet.Range(.Cells(2, 125), .Cells(intnumber + 1, 125))
Set xlFiveYr = xlSheet.Range(.Cells(2, 126), .Cells(intnumber + 1, 126))
Set xlTenYr = xlSheet.Range(.Cells(2, 127), .Cells(intnumber + 1, 127))
End With

With xlSheet
xlThreeMo.FormulaR1C1 =
"=IF(Countblank((RC[-4]:RC[-2]))>0,-500,Product(RC[-4]:RC[-2])-1)"
xlOneYr.FormulaR1C1 =
"=IF(Countblank((RC[-14]:RC[-3]))>0,-500,Product(RC[-14]:RC[-3])-1)"
xlThreeYr.FormulaR1C1 =
"=IF(Countblank((RC[-39]:RC[-4]))>0,-500,Product(RC[-39]:RC[-4])^(1/3)-1)"
xlFiveYr.FormulaR1C1 =
"=IF(Countblank((RC[-64]:RC[-5]))>0,-500,Product(RC[-64]:RC[-5])^(1/5)-1)"
xlTenYr.FormulaR1C1 =
"=IF(countblank((RC[-125]:RC[-6]))>0,-500,Product(RC[-125]:RC[-6])^(1/10)-1)"
End With

With xlSheet
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
End With

With xlSheet
.Columns("B:DQ").Select
.Columns("B:DQ").Delete Shift:=xlToLeft
End With

With xlSheet
Set xlDate = xlSheet.Range(.Cells(2, 2), .Cells(intnumber + 1, 2))
End With

xlDate.Value = strDate

With xlSheet
.Range("A1").Value = "fund"
.Range("B1").Value = "End Date"
.Range("C1").Value = "3Mo"
.Range("D1").Value = "1Yr"
.Range("E1").Value = "3Yr"
.Range("F1").Value = "5Yr"
.Range("G1").Value = "10Yr"
End With

With xlSheet
Cells.Select
Selection.Replace What:="-500", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With

xlApp.DisplayAlerts = False
xlWorkbook.SaveAs "G:\Investments\Database\File1.xls"
xlWorkbook.Close
Set xlWorkbook = Nothing
xlApp.Quit
Set xlApp = Nothing

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Output
Table", _
"G:\Investments\Database\File1.xls", True

MsgBox "Congrats Dillweed"

Set xlThreeMo = Nothing
Set xlOneYr = Nothing
Set xlThreeYr = Nothing
Set xlFiveYr = Nothing
Set xlTenYr = Nothing
Set xlrng2 = Nothing
Set xlDate = Nothing
Set objRST = Nothing
Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlApp = Nothing
End Sub

RoyVidar said:
Austin said:
Hi, I am running the code below and two questions coming up:

a) There is still an instance of Excel running in my processes once
it is complete
b) Every other time I run it, I get run-time 462 'The remote server
machine does not exist or is unavailable'

If you can help me out I would really appreciate it, thanks a lot.

Option Explicit

Private Sub Command1_Click()
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlWorkbook As Excel.Workbook
Dim strDate As Date
Dim xlThreeMo As Excel.Range
Dim xlOneYr As Excel.Range
Dim xlThreeYr As Excel.Range
Dim xlFiveYr As Excel.Range
Dim xlTenYr As Excel.Range
Dim xlrng2 As Excel.Range
Dim xlDate As Excel.Range
Dim objRST As Recordset
Dim intnumber As Integer
Dim strQuery As String
Dim strSheetName As String

'Queries the data
strQuery = "TRANSFORM Sum([Month Value.return]+1) As Return " & _
"SELECT Fund.Fund " & _
"From Dates, Fund INNER JOIN [Month Value] ON Fund.[Fund
ID] = [Month Value].[Fund ID] " & _
"WHERE (((IIF([Month Value.End Date]>[Dates.Ten Year] AND
" & _ "[Month Value.End Date]<=[Dates.This
Month],1,0))=1)) " & _ "GROUP BY Fund.Fund " & _
"PIVOT [Month Value].[End Date];"
strSheetName = Left(strQuery, 10)
strSheetName = Trim(strSheetName)

'Creates the worksheet
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set xlWorkbook = xlApp.Workbooks.Add
Set objRST = Application.CurrentDb.OpenRecordset(strQuery)

strDate = Me.Text2.Value

With objRST
If Not .EOF Then .MoveLast
intnumber = objRST.RecordCount
.MoveFirst
End With

Set xlSheet = xlWorkbook.Sheets(1)

With xlSheet
.Range("A2").CopyFromRecordset objRST
.Name = strSheetName
End With

With xlSheet
Set xlThreeMo = xlSheet.Range(.Cells(2, 123), .Cells(intnumber +
1, 123)) Set xlOneYr = xlSheet.Range(.Cells(2, 124),
.Cells(intnumber + 1, 124)) Set xlThreeYr =
xlSheet.Range(.Cells(2, 125), .Cells(intnumber + 1, 125)) Set
xlFiveYr = xlSheet.Range(.Cells(2, 126), .Cells(intnumber + 1, 126))
Set xlTenYr = xlSheet.Range(.Cells(2, 127), .Cells(intnumber + 1,
127)) End With


xlThreeMo.FormulaR1C1 =
"=IF(Countblank((RC[-4]:RC[-2]))>0,-500,Product(RC[-4]:RC[-2])-1)"
xlOneYr.FormulaR1C1 =
"=IF(Countblank((RC[-14]:RC[-3]))>0,-500,Product(RC[-14]:RC[-3])-1)"
xlThreeYr.FormulaR1C1 =
"=IF(Countblank((RC[-39]:RC[-4]))>0,-500,Product(RC[-39]:RC[-4])^(1/3)-1)"
xlFiveYr.FormulaR1C1 =
"=IF(Countblank((RC[-64]:RC[-5]))>0,-500,Product(RC[-64]:RC[-5])^(1/5)-1)"
xlTenYr.FormulaR1C1 =
"=IF(countblank((RC[-125]:RC[-6]))>0,-500,Product(RC[-125]:RC[-6])^(1/10)-1)"


With xlSheet
.Range("A1:ZZ5000").Select
.Range("A1:ZZ5000").Copy
.Range("A1:ZZ5000").Activate
.Range("A1:ZZ5000").PasteSpecial (xlPasteValues)
End With

With xlSheet
.Columns("B:DQ").Select
.Columns("B:DQ").Delete Shift:=xlToLeft
End With

With xlSheet
Set xlDate = xlSheet.Range(.Cells(2, 2), .Cells(intnumber + 1, 2))
End With

xlDate.Value = strDate

With xlSheet
Range("A1").Select
ActiveCell.FormulaR1C1 = "fund"
Range("B1").Select
ActiveCell.FormulaR1C1 = "End Date"
Range("C1").Select
ActiveCell.FormulaR1C1 = "3Mo"
Range("D1").Select
ActiveCell.FormulaR1C1 = "1Yr"
Range("E1").Select
ActiveCell.FormulaR1C1 = "3Yr"
Range("F1").Select
ActiveCell.FormulaR1C1 = "5Yr"
Range("G1").Select
ActiveCell.FormulaR1C1 = "10Yr"
End With

With xlApp
Excel.Application.DisplayAlerts = False
.Workbooks(1).SaveAs "C:\Users\Austin Meier\Desktop\File1.xlsx"
.Quit
End With

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Output
Table", _
"c:\Users\Austin Meier\Desktop\File1.xlsx", True

Set xlApp = Nothing
Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlThreeMo = Nothing
Set xlOneYr = Nothing
Set xlThreeYr = Nothing
Set xlFiveYr = Nothing
Set xlTenYr = Nothing
Set xlrng2 = Nothing
Set xlDate = Nothing
Set objRST = Nothing
End Sub
Click to expand...

It's this

With xlSheet
Range("A1").Select
ActiveCell.FormulaR1C1 = "fund"
Range("B1").Select
ActiveCell.FormulaR1C1 = "End Date"
Range("C1").Select
ActiveCell.FormulaR1C1 = "3Mo"
Range("D1").Select
ActiveCell.FormulaR1C1 = "1Yr"
Range("E1").Select
ActiveCell.FormulaR1C1 = "3Yr"
Range("F1").Select
ActiveCell.FormulaR1C1 = "5Yr"
Range("G1").Select
ActiveCell.FormulaR1C1 = "10Yr"
End With

That you need to replace with something like

With xlSheet
.Range("A1").Value = "fund"
.Range("B1").Value = "End Date"
....

i e
1 - "anchor" it in a parent object (the actual problem)
2 - avoid selects (performance)

Also here

With xlApp
Excel.Application.DisplayAlerts = False
.Workbooks(1).SaveAs "C:\Users\Austin Meier\Desktop\File1.xlsx"
.Quit
End With

Rather do

xlApp.DisplayAlerts = False
xlWorkbook.SaveAs "C:\Users\Austin Meier\Desktop\File1.xlsx"
xlWorkbook.Close
set xlWorkbook = nothing
xlApp.Quit
Set xlApp = nothing

See http://support.microsoft.com/default.aspx?kbid=178510 for more
info
Click to expand...
 
Austin said:
Thanks Roy -

I implemented the changes that you provided below but it still doesnt
look like it is killing the excel process. Also, the 462 error is
still occuring. I have made several changes, here is the updated
code:

Option Compare Database

Private Sub Command0_Click()
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlWorkbook As Excel.Workbook
Dim strDate As Date
Dim intMonth As Integer
Dim xlThreeMo As Excel.Range
Dim xlOneYr As Excel.Range
Dim xlThreeYr As Excel.Range
Dim xlFiveYr As Excel.Range
Dim xlTenYr As Excel.Range
Dim xlrng2 As Excel.Range
Dim xlDate As Excel.Range
Dim objRST As Recordset
Dim intnumber As Integer
Dim strQuery As String
Dim strSheetName As String

'Queries the data
strQuery = "TRANSFORM Sum([Month Value.return]+1) As Return " & _
"SELECT Fund.Fund " & _
"From Dates, Fund INNER JOIN [Month Value] ON Fund.[Fund
ID] = [Month Value].[Fund ID] " & _
"WHERE (((IIF([Month Value.End Date]>[Dates.Ten Year] AND
" & _ "[Month Value.End Date]<=[Dates.This
Month],1,0))=1)) " & _ "GROUP BY Fund.Fund " & _
"PIVOT [Month Value].[End Date];"
strSheetName = Left(strQuery, 10)
strSheetName = Trim(strSheetName)

'Creates the worksheet
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set xlWorkbook = xlApp.Workbooks.Add
Set objRST = Application.CurrentDb.OpenRecordset(strQuery)

strDate = Me.Text2.Value

With objRST
If Not .EOF Then .MoveLast
intnumber = objRST.RecordCount
.MoveFirst
End With

Set xlSheet = xlWorkbook.Sheets(1)

With xlSheet
.Range("A2").CopyFromRecordset objRST
.Name = strSheetName
End With

With xlSheet
Set xlThreeMo = xlSheet.Range(.Cells(2, 123), .Cells(intnumber +
1, 123)) Set xlOneYr = xlSheet.Range(.Cells(2, 124),
.Cells(intnumber + 1, 124)) Set xlThreeYr =
xlSheet.Range(.Cells(2, 125), .Cells(intnumber + 1, 125)) Set
xlFiveYr = xlSheet.Range(.Cells(2, 126), .Cells(intnumber + 1, 126))
Set xlTenYr = xlSheet.Range(.Cells(2, 127), .Cells(intnumber + 1,
127)) End With

With xlSheet
xlThreeMo.FormulaR1C1 =
"=IF(Countblank((RC[-4]:RC[-2]))>0,-500,Product(RC[-4]:RC[-2])-1)"
xlOneYr.FormulaR1C1 =
"=IF(Countblank((RC[-14]:RC[-3]))>0,-500,Product(RC[-14]:RC[-3])-1)"
xlThreeYr.FormulaR1C1 =
"=IF(Countblank((RC[-39]:RC[-4]))>0,-500,Product(RC[-39]:RC[-4])^(1/3)-1)"
xlFiveYr.FormulaR1C1 =
"=IF(Countblank((RC[-64]:RC[-5]))>0,-500,Product(RC[-64]:RC[-5])^(1/5)-1)"
xlTenYr.FormulaR1C1 =
"=IF(countblank((RC[-125]:RC[-6]))>0,-500,Product(RC[-125]:RC[-6])^(1/10)-1)"
End With

With xlSheet
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
End With

With xlSheet
.Columns("B:DQ").Select
.Columns("B:DQ").Delete Shift:=xlToLeft
End With

With xlSheet
Set xlDate = xlSheet.Range(.Cells(2, 2), .Cells(intnumber + 1,
2)) End With

xlDate.Value = strDate

With xlSheet
.Range("A1").Value = "fund"
.Range("B1").Value = "End Date"
.Range("C1").Value = "3Mo"
.Range("D1").Value = "1Yr"
.Range("E1").Value = "3Yr"
.Range("F1").Value = "5Yr"
.Range("G1").Value = "10Yr"
End With

With xlSheet
Cells.Select
Selection.Replace What:="-500", Replacement:="", LookAt:=xlPart,
_ SearchOrder:=xlByRows, MatchCase:=False,
SearchFormat:=False, _ ReplaceFormat:=False
End With

xlApp.DisplayAlerts = False
xlWorkbook.SaveAs "G:\Investments\Database\File1.xls"
xlWorkbook.Close
Set xlWorkbook = Nothing
xlApp.Quit
Set xlApp = Nothing

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Output
Table", _
"G:\Investments\Database\File1.xls", True

MsgBox "Congrats Dillweed"

Set xlThreeMo = Nothing
Set xlOneYr = Nothing
Set xlThreeYr = Nothing
Set xlFiveYr = Nothing
Set xlTenYr = Nothing
Set xlrng2 = Nothing
Set xlDate = Nothing
Set objRST = Nothing
Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlApp = Nothing
End Sub

RoyVidar said:
Austin said:
Hi, I am running the code below and two questions coming up:

a) There is still an instance of Excel running in my processes
once it is complete
b) Every other time I run it, I get run-time 462 'The remote
server machine does not exist or is unavailable'

If you can help me out I would really appreciate it, thanks a lot.

Option Explicit

Private Sub Command1_Click()
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlWorkbook As Excel.Workbook
Dim strDate As Date
Dim xlThreeMo As Excel.Range
Dim xlOneYr As Excel.Range
Dim xlThreeYr As Excel.Range
Dim xlFiveYr As Excel.Range
Dim xlTenYr As Excel.Range
Dim xlrng2 As Excel.Range
Dim xlDate As Excel.Range
Dim objRST As Recordset
Dim intnumber As Integer
Dim strQuery As String
Dim strSheetName As String

'Queries the data
strQuery = "TRANSFORM Sum([Month Value.return]+1) As Return " & _
"SELECT Fund.Fund " & _
"From Dates, Fund INNER JOIN [Month Value] ON
Fund.[Fund ID] = [Month Value].[Fund ID] " & _
"WHERE (((IIF([Month Value.End Date]>[Dates.Ten Year]
AND " & _ "[Month Value.End Date]<=[Dates.This
Month],1,0))=1)) " & _ "GROUP BY Fund.Fund " & _
"PIVOT [Month Value].[End Date];"
strSheetName = Left(strQuery, 10)
strSheetName = Trim(strSheetName)

'Creates the worksheet
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set xlWorkbook = xlApp.Workbooks.Add
Set objRST = Application.CurrentDb.OpenRecordset(strQuery)

strDate = Me.Text2.Value

With objRST
If Not .EOF Then .MoveLast
intnumber = objRST.RecordCount
.MoveFirst
End With

Set xlSheet = xlWorkbook.Sheets(1)

With xlSheet
.Range("A2").CopyFromRecordset objRST
.Name = strSheetName
End With

With xlSheet
Set xlThreeMo = xlSheet.Range(.Cells(2, 123), .Cells(intnumber
+ 1, 123)) Set xlOneYr = xlSheet.Range(.Cells(2, 124),
.Cells(intnumber + 1, 124)) Set xlThreeYr =
xlSheet.Range(.Cells(2, 125), .Cells(intnumber + 1, 125)) Set
xlFiveYr = xlSheet.Range(.Cells(2, 126), .Cells(intnumber + 1,
126)) Set xlTenYr = xlSheet.Range(.Cells(2, 127),
.Cells(intnumber + 1, 127)) End With


xlThreeMo.FormulaR1C1 =
"=IF(Countblank((RC[-4]:RC[-2]))>0,-500,Product(RC[-4]:RC[-2])-1)"
xlOneYr.FormulaR1C1 =
"=IF(Countblank((RC[-14]:RC[-3]))>0,-500,Product(RC[-14]:RC[-3])-1)"
xlThreeYr.FormulaR1C1 =
"=IF(Countblank((RC[-39]:RC[-4]))>0,-500,Product(RC[-39]:RC[-4])^(1/3)-1)"
xlFiveYr.FormulaR1C1 =
"=IF(Countblank((RC[-64]:RC[-5]))>0,-500,Product(RC[-64]:RC[-5])^(1/5)-1)"
xlTenYr.FormulaR1C1 =
"=IF(countblank((RC[-125]:RC[-6]))>0,-500,Product(RC[-125]:RC[-6])^(1/10)-1)"


With xlSheet
.Range("A1:ZZ5000").Select
.Range("A1:ZZ5000").Copy
.Range("A1:ZZ5000").Activate
.Range("A1:ZZ5000").PasteSpecial (xlPasteValues)
End With

With xlSheet
.Columns("B:DQ").Select
.Columns("B:DQ").Delete Shift:=xlToLeft
End With

With xlSheet
Set xlDate = xlSheet.Range(.Cells(2, 2), .Cells(intnumber + 1, 2))
End With

xlDate.Value = strDate

With xlSheet
Range("A1").Select
ActiveCell.FormulaR1C1 = "fund"
Range("B1").Select
ActiveCell.FormulaR1C1 = "End Date"
Range("C1").Select
ActiveCell.FormulaR1C1 = "3Mo"
Range("D1").Select
ActiveCell.FormulaR1C1 = "1Yr"
Range("E1").Select
ActiveCell.FormulaR1C1 = "3Yr"
Range("F1").Select
ActiveCell.FormulaR1C1 = "5Yr"
Range("G1").Select
ActiveCell.FormulaR1C1 = "10Yr"
End With

With xlApp
Excel.Application.DisplayAlerts = False
.Workbooks(1).SaveAs "C:\Users\Austin Meier\Desktop\File1.xlsx"
.Quit
End With

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12,
"Output Table", _
"c:\Users\Austin Meier\Desktop\File1.xlsx", True

Set xlApp = Nothing
Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlThreeMo = Nothing
Set xlOneYr = Nothing
Set xlThreeYr = Nothing
Set xlFiveYr = Nothing
Set xlTenYr = Nothing
Set xlrng2 = Nothing
Set xlDate = Nothing
Set objRST = Nothing
End Sub
Click to expand...

It's this

With xlSheet
Range("A1").Select
ActiveCell.FormulaR1C1 = "fund"
Range("B1").Select
ActiveCell.FormulaR1C1 = "End Date"
Range("C1").Select
ActiveCell.FormulaR1C1 = "3Mo"
Range("D1").Select
ActiveCell.FormulaR1C1 = "1Yr"
Range("E1").Select
ActiveCell.FormulaR1C1 = "3Yr"
Range("F1").Select
ActiveCell.FormulaR1C1 = "5Yr"
Range("G1").Select
ActiveCell.FormulaR1C1 = "10Yr"
End With

That you need to replace with something like

With xlSheet
.Range("A1").Value = "fund"
.Range("B1").Value = "End Date"
....

i e
1 - "anchor" it in a parent object (the actual problem)
2 - avoid selects (performance)

Also here

With xlApp
Excel.Application.DisplayAlerts = False
.Workbooks(1).SaveAs "C:\Users\Austin Meier\Desktop\File1.xlsx"
.Quit
End With

Rather do

xlApp.DisplayAlerts = False
xlWorkbook.SaveAs "C:\Users\Austin Meier\Desktop\File1.xlsx"
xlWorkbook.Close
set xlWorkbook = nothing
xlApp.Quit
Set xlApp = nothing

See http://support.microsoft.com/default.aspx?kbid=178510 for more
info
Click to expand...
Click to expand...

I think that without your new changes, it would have worked.

The new stuff you've added, has the same error as previous, you are
using methods, properties and objects belonging to the automated
application - without anchoring them to their parent objects. That
will cause the behaviour you're seeing.

I'll think I'll be rude enough to suggest rereading the link I gave,
look at your original code, study what I suggested to change, look
at your current code, look at the new code elements and see if you
can manage ;-)

If not, post again, and I could have a go (unless someone else steps
in).
 
Thanks Again Roy,

I made some amendments to what I had earlier. I am relatively new at this,
but this looks like it is correct. However, now I am getting an additional
error stating:

"Compile Error, Variable not defined" about the "acSpreadsheetTypeExcel12"
in the TransferSpreadsheet command


If you are able to give any more guidance, I would appreciate it.

Thanks





Option Explicit

Private Sub Command0_Click()
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlWorkbook As Excel.Workbook
Dim strDate As Date
Dim intMonth As Integer
Dim xlThreeMo As Excel.Range
Dim xlOneYr As Excel.Range
Dim xlThreeYr As Excel.Range
Dim xlFiveYr As Excel.Range
Dim xlTenYr As Excel.Range
Dim xlrng2 As Excel.Range
Dim xlDate As Excel.Range
Dim objRST As Recordset
Dim intnumber As Integer
Dim strQuery As String
Dim strSheetName As String

'Queries the data
strQuery = "TRANSFORM Sum([Month Value.return]+1) As Return " & _
"SELECT Fund.Fund " & _
"From Dates, Fund INNER JOIN [Month Value] ON Fund.[Fund ID] =
[Month Value].[Fund ID] " & _
"WHERE (((IIF([Month Value.End Date]>[Dates.Ten Year] AND " & _
"[Month Value.End Date]<=[Dates.This Month],1,0))=1)) " & _
"GROUP BY Fund.Fund " & _
"PIVOT [Month Value].[End Date];"
strSheetName = Left(strQuery, 10)
strSheetName = Trim(strSheetName)

'Creates the worksheet
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set xlWorkbook = xlApp.Workbooks.Add
Set objRST = Application.CurrentDb.OpenRecordset(strQuery)

strDate = Me.Text2.Value

With objRST
If Not .EOF Then .MoveLast
intnumber = objRST.RecordCount
.MoveFirst
End With

Set xlSheet = xlWorkbook.Sheets(1)

With xlSheet
.Range("A2").CopyFromRecordset objRST
.Name = strSheetName
End With

With xlSheet
Set xlThreeMo = xlSheet.Range(xlSheet.Cells(2, 123),
xlSheet.Cells(intnumber + 1, 123))
Set xlOneYr = xlSheet.Range(xlSheet.Cells(2, 124),
xlSheet.Cells(intnumber + 1, 124))
Set xlThreeYr = xlSheet.Range(xlSheet.Cells(2, 125),
xlSheet.Cells(intnumber + 1, 125))
Set xlFiveYr = xlSheet.Range(xlSheet.Cells(2, 126),
xlSheet.Cells(intnumber + 1, 126))
Set xlTenYr = xlSheet.Range(xlSheet.Cells(2, 127),
xlSheet.Cells(intnumber + 1, 127))
End With

xlThreeMo.FormulaR1C1 =
"=IF(Countblank((RC[-4]:RC[-2]))>0,-500,Product(RC[-4]:RC[-2])-1)"
xlOneYr.FormulaR1C1 =
"=IF(Countblank((RC[-14]:RC[-3]))>0,-500,Product(RC[-14]:RC[-3])-1)"
xlThreeYr.FormulaR1C1 =
"=IF(Countblank((RC[-39]:RC[-4]))>0,-500,Product(RC[-39]:RC[-4])^(1/3)-1)"
xlFiveYr.FormulaR1C1 =
"=IF(Countblank((RC[-64]:RC[-5]))>0,-500,Product(RC[-64]:RC[-5])^(1/5)-1)"
xlTenYr.FormulaR1C1 =
"=IF(countblank((RC[-125]:RC[-6]))>0,-500,Product(RC[-125]:RC[-6])^(1/10)-1)"

With xlSheet
.Range("A1:FA5000").Select
.Range("A1:FA5000").Copy
.Range("A1:FA5000").Activate
.Range("A1:FA5000").PasteSpecial
End With

With xlSheet
.Columns("B:DQ").Select
.Columns("B:DQ").Delete Shift:=xlToLeft
End With

With xlSheet
Set xlDate = xlSheet.Range(xlSheet.Cells(2, 2), xlSheet.Cells(intnumber
+ 1, 2))
End With

xlDate.Value = strDate

With xlSheet
.Range("A1").Value = "fund"
.Range("B1").Value = "End Date"
.Range("C1").Value = "3Mo"
.Range("D1").Value = "1Yr"
.Range("E1").Value = "3Yr"
.Range("F1").Value = "5Yr"
.Range("G1").Value = "10Yr"
End With

With xlSheet
.Range("A1:AF5000").Replace What:="-500", Replacement:="", LookAt:=2, _
SearchOrder:=1, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With

xlApp.DisplayAlerts = False
xlWorkbook.SaveAs "G:\Investments\Database\File1.xls"
xlWorkbook.Close
Set xlWorkbook = Nothing
xlApp.Quit
Set xlApp = Nothing

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Output
Table", _
"G:\Investments\Database\File1.xls", True

MsgBox "Congrats Dillweed"

Set xlThreeMo = Nothing
Set xlOneYr = Nothing
Set xlThreeYr = Nothing
Set xlFiveYr = Nothing
Set xlTenYr = Nothing
Set xlrng2 = Nothing
Set xlDate = Nothing
Set objRST = Nothing
Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlApp = Nothing
End Sub
 
Austin said:
Thanks Again Roy,

I made some amendments to what I had earlier. I am relatively new at
this, but this looks like it is correct. However, now I am getting
an additional error stating:

"Compile Error, Variable not defined" about the
"acSpreadsheetTypeExcel12" in the TransferSpreadsheet command


If you are able to give any more guidance, I would appreciate it.

Thanks





Option Explicit

Private Sub Command0_Click()
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlWorkbook As Excel.Workbook
Dim strDate As Date
Dim intMonth As Integer
Dim xlThreeMo As Excel.Range
Dim xlOneYr As Excel.Range
Dim xlThreeYr As Excel.Range
Dim xlFiveYr As Excel.Range
Dim xlTenYr As Excel.Range
Dim xlrng2 As Excel.Range
Dim xlDate As Excel.Range
Dim objRST As Recordset
Dim intnumber As Integer
Dim strQuery As String
Dim strSheetName As String

'Queries the data
strQuery = "TRANSFORM Sum([Month Value.return]+1) As Return " & _
"SELECT Fund.Fund " & _
"From Dates, Fund INNER JOIN [Month Value] ON Fund.[Fund
ID] = [Month Value].[Fund ID] " & _
"WHERE (((IIF([Month Value.End Date]>[Dates.Ten Year] AND
" & _ "[Month Value.End Date]<=[Dates.This
Month],1,0))=1)) " & _ "GROUP BY Fund.Fund " & _
"PIVOT [Month Value].[End Date];"
strSheetName = Left(strQuery, 10)
strSheetName = Trim(strSheetName)

'Creates the worksheet
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set xlWorkbook = xlApp.Workbooks.Add
Set objRST = Application.CurrentDb.OpenRecordset(strQuery)

strDate = Me.Text2.Value

With objRST
If Not .EOF Then .MoveLast
intnumber = objRST.RecordCount
.MoveFirst
End With

Set xlSheet = xlWorkbook.Sheets(1)

With xlSheet
.Range("A2").CopyFromRecordset objRST
.Name = strSheetName
End With

With xlSheet
Set xlThreeMo = xlSheet.Range(xlSheet.Cells(2, 123),
xlSheet.Cells(intnumber + 1, 123))
Set xlOneYr = xlSheet.Range(xlSheet.Cells(2, 124),
xlSheet.Cells(intnumber + 1, 124))
Set xlThreeYr = xlSheet.Range(xlSheet.Cells(2, 125),
xlSheet.Cells(intnumber + 1, 125))
Set xlFiveYr = xlSheet.Range(xlSheet.Cells(2, 126),
xlSheet.Cells(intnumber + 1, 126))
Set xlTenYr = xlSheet.Range(xlSheet.Cells(2, 127),
xlSheet.Cells(intnumber + 1, 127))
End With

xlThreeMo.FormulaR1C1 =
"=IF(Countblank((RC[-4]:RC[-2]))>0,-500,Product(RC[-4]:RC[-2])-1)"
xlOneYr.FormulaR1C1 =
"=IF(Countblank((RC[-14]:RC[-3]))>0,-500,Product(RC[-14]:RC[-3])-1)"
xlThreeYr.FormulaR1C1 =
"=IF(Countblank((RC[-39]:RC[-4]))>0,-500,Product(RC[-39]:RC[-4])^(1/3)-1)"
xlFiveYr.FormulaR1C1 =
"=IF(Countblank((RC[-64]:RC[-5]))>0,-500,Product(RC[-64]:RC[-5])^(1/5)-1)"
xlTenYr.FormulaR1C1 =
"=IF(countblank((RC[-125]:RC[-6]))>0,-500,Product(RC[-125]:RC[-6])^(1/10)-1)"

With xlSheet
.Range("A1:FA5000").Select
.Range("A1:FA5000").Copy
.Range("A1:FA5000").Activate
.Range("A1:FA5000").PasteSpecial
End With

With xlSheet
.Columns("B:DQ").Select
.Columns("B:DQ").Delete Shift:=xlToLeft
End With

With xlSheet
Set xlDate = xlSheet.Range(xlSheet.Cells(2, 2),
xlSheet.Cells(intnumber + 1, 2))
End With

xlDate.Value = strDate

With xlSheet
.Range("A1").Value = "fund"
.Range("B1").Value = "End Date"
.Range("C1").Value = "3Mo"
.Range("D1").Value = "1Yr"
.Range("E1").Value = "3Yr"
.Range("F1").Value = "5Yr"
.Range("G1").Value = "10Yr"
End With

With xlSheet
.Range("A1:AF5000").Replace What:="-500", Replacement:="",
LookAt:=2, _ SearchOrder:=1, MatchCase:=False,
SearchFormat:=False, _ ReplaceFormat:=False
End With

xlApp.DisplayAlerts = False
xlWorkbook.SaveAs "G:\Investments\Database\File1.xls"
xlWorkbook.Close
Set xlWorkbook = Nothing
xlApp.Quit
Set xlApp = Nothing

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Output
Table", _
"G:\Investments\Database\File1.xls", True

MsgBox "Congrats Dillweed"

Set xlThreeMo = Nothing
Set xlOneYr = Nothing
Set xlThreeYr = Nothing
Set xlFiveYr = Nothing
Set xlTenYr = Nothing
Set xlrng2 = Nothing
Set xlDate = Nothing
Set objRST = Nothing
Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlApp = Nothing
End Sub
Click to expand...

Good job!

My guess would be that you are working with one of the versions prior
to Access 2007, in which case that format isn't defined.

Try using for instance acSpreadsheetTypeExcel9 see
http://msdn.microsoft.com/en-us/library/bb214134.aspx (click
AcSpreadSheetType for info on constants)

Hopefully it will work now ;-)
 
Back
Top