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

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
 
R

RoyVidar

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
 
A

Austin

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...
 
R

RoyVidar

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).
 
A

Austin

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
 
R

RoyVidar

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 ;-)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Control Excel from Access 2
1004 error only after 1st run 0
Creating Pivot Table with Macro using Multiple Sheets 0
Exporting curretn recordset to Excel - only working first time! 1
Control Excel from Access 4
macro to copy rows that contain a cell with a certain number 3
Formula in macro gives "Run-time error '1004':" 1
Insert row gives run-time error 13 message 1

Top