Hi,
I have written some code which works kind of.
Basically i am exporting data from Access 2000 to Excel 2000 onto a template in excel then making a copy of the worsheet and saving the file. The code works 1st time but second time when i try opeing up excel it does not open up and when i try runnig my code again i get a debug message come up
Run-time error "462":
The remote server machine does not exist or is unavailable
What i have to do is close my database and end process excel under taks manager for it to work.
I think in the code its not closing the application and its in memory.
Below is the code
Thanks in advance
Option Compare Database
Option Explicit
Public xlApp As Excel.Application 'Variable to create a public instance of Excel
Public xlBook As Excel.Workbook 'Variable to create an Excel Workbook
Public xlSheet As Excel.Worksheet 'Variable to create an Excel Worsheet
Public Function fn_ExtractCustomerInfo() As Boolean
Dim db As Database
Dim rst As Recordset
Dim sOutPut As String
Dim sTemplate As String
Dim x As Integer
Dim strFormat As String
Dim intFormat As Integer
Dim sTitle As String
Dim sCustomer As String
Dim dStart As Date
Dim dEnd As Date
Dim sAccount As String
'="Unit Sales by Date Range for " & [Forms]![frmSalesUnitPrice]![cboAccount].Column(2) & " from " & [Forms]![frmSalesUnitPrice]![txtStart] & " and " & [Forms]![frmSalesUnitPrice]![txtEnd]
sTitle = "Unit Sales by Date Range for "
sCustomer = [Forms]![frmSalesUnitPrice]![cboAccount].Column(2)
dStart = [Forms]![frmSalesUnitPrice]![txtStart]
dEnd = [Forms]![frmSalesUnitPrice]![txtEnd]
sAccount = [Forms]![frmSalesUnitPrice]![cboAccount].Column(1)
sTitle = sTitle & sCustomer & " from " & dStart & " and " & dEnd
x = 1
On Error GoTo Error_Handler:
sOutPut = "C:\StockOfferLog\CustomerHistoryExportTemplate.xls"
'FileCopy sTemplate, sOutPut
Set xlApp = New Excel.Application 'Open excel Application
Set xlBook = xlApp.Workbooks.Add 'Open excel book with the application
Set xlBook = xlApp.Workbooks.Open(sOutPut)
Set xlSheet = xlBook.Worksheets("Sheet1")
xlSheet.Name = "Extract"
DoCmd.Hourglass True
Set db = CurrentDb 'Sets database object as the current database
Set rst = db.OpenRecordset("tblCustomerHistoryLastPriceExportTemp") 'opens query from where the data comes
xlSheet.Range("a1").Value = sTitle
xlSheet.Range("a2").Value = "Stock Code"
xlSheet.Range("b2").Value = "Stock Name"
xlSheet.Range("c2").Value = "FreeStock"
xlSheet.Range("d2").Value = "QTY Sold"
xlSheet.Range("e2").Value = "CurrencyCode"
xlSheet.Range("f2").Value = "Unit Price"
xlSheet.Range("g2").Value = "LastDate"
Do Until rst.EOF
' With rst
x = x + 1
' If Not rst.EOF Then 'If not end of file then execute the following
xlSheet.Cells((x + 1), 1).Value = x
xlSheet.Cells((x + 1), 1).Value = rst("Stock Code")
xlSheet.Cells((x + 1), 2).Value = rst("Stock Name")
xlSheet.Cells((x + 1), 3).Value = rst("FreeStock")
xlSheet.Cells((x + 1), 4).Value = rst("QTY Sold")
xlSheet.Cells((x + 1), 5).Value = rst("CurrencyCode")
xlSheet.Cells((x + 1), 6).Value = rst("Unit Price")
xlSheet.Cells((x + 1), 7).Value = rst("LastDate")
rst.MoveNext
Loop
' End With
rst.Close 'Close recordset once program loop has finished.
DoCmd.SetWarnings False
db.Close
Set rst = Nothing 'Destroy the recordset object to free up memory space.
Set db = Nothing
Call FormatExcelExport
xlBook.SaveAs "C:\StockOfferLog\" & sAccount & Format(Date, "dd_mm_yyyy") & ".xls" 'Save the Excel file
xlBook.Close 'Close the Excel file.
xlApp.Quit
Set xlApp = Nothing 'Destroy the Excel object created by the program to free up memory space.
Exit_Line:
DoCmd.SetWarnings True
DoCmd.Hourglass False
Exit Function
Error_Handler:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_Line
End Function
I have written some code which works kind of.
Basically i am exporting data from Access 2000 to Excel 2000 onto a template in excel then making a copy of the worsheet and saving the file. The code works 1st time but second time when i try opeing up excel it does not open up and when i try runnig my code again i get a debug message come up
Run-time error "462":
The remote server machine does not exist or is unavailable
What i have to do is close my database and end process excel under taks manager for it to work.
I think in the code its not closing the application and its in memory.
Below is the code
Thanks in advance
Option Compare Database
Option Explicit
Public xlApp As Excel.Application 'Variable to create a public instance of Excel
Public xlBook As Excel.Workbook 'Variable to create an Excel Workbook
Public xlSheet As Excel.Worksheet 'Variable to create an Excel Worsheet
Public Function fn_ExtractCustomerInfo() As Boolean
Dim db As Database
Dim rst As Recordset
Dim sOutPut As String
Dim sTemplate As String
Dim x As Integer
Dim strFormat As String
Dim intFormat As Integer
Dim sTitle As String
Dim sCustomer As String
Dim dStart As Date
Dim dEnd As Date
Dim sAccount As String
'="Unit Sales by Date Range for " & [Forms]![frmSalesUnitPrice]![cboAccount].Column(2) & " from " & [Forms]![frmSalesUnitPrice]![txtStart] & " and " & [Forms]![frmSalesUnitPrice]![txtEnd]
sTitle = "Unit Sales by Date Range for "
sCustomer = [Forms]![frmSalesUnitPrice]![cboAccount].Column(2)
dStart = [Forms]![frmSalesUnitPrice]![txtStart]
dEnd = [Forms]![frmSalesUnitPrice]![txtEnd]
sAccount = [Forms]![frmSalesUnitPrice]![cboAccount].Column(1)
sTitle = sTitle & sCustomer & " from " & dStart & " and " & dEnd
x = 1
On Error GoTo Error_Handler:
sOutPut = "C:\StockOfferLog\CustomerHistoryExportTemplate.xls"
'FileCopy sTemplate, sOutPut
Set xlApp = New Excel.Application 'Open excel Application
Set xlBook = xlApp.Workbooks.Add 'Open excel book with the application
Set xlBook = xlApp.Workbooks.Open(sOutPut)
Set xlSheet = xlBook.Worksheets("Sheet1")
xlSheet.Name = "Extract"
DoCmd.Hourglass True
Set db = CurrentDb 'Sets database object as the current database
Set rst = db.OpenRecordset("tblCustomerHistoryLastPriceExportTemp") 'opens query from where the data comes
xlSheet.Range("a1").Value = sTitle
xlSheet.Range("a2").Value = "Stock Code"
xlSheet.Range("b2").Value = "Stock Name"
xlSheet.Range("c2").Value = "FreeStock"
xlSheet.Range("d2").Value = "QTY Sold"
xlSheet.Range("e2").Value = "CurrencyCode"
xlSheet.Range("f2").Value = "Unit Price"
xlSheet.Range("g2").Value = "LastDate"
Do Until rst.EOF
' With rst
x = x + 1
' If Not rst.EOF Then 'If not end of file then execute the following
xlSheet.Cells((x + 1), 1).Value = x
xlSheet.Cells((x + 1), 1).Value = rst("Stock Code")
xlSheet.Cells((x + 1), 2).Value = rst("Stock Name")
xlSheet.Cells((x + 1), 3).Value = rst("FreeStock")
xlSheet.Cells((x + 1), 4).Value = rst("QTY Sold")
xlSheet.Cells((x + 1), 5).Value = rst("CurrencyCode")
xlSheet.Cells((x + 1), 6).Value = rst("Unit Price")
xlSheet.Cells((x + 1), 7).Value = rst("LastDate")
rst.MoveNext
Loop
' End With
rst.Close 'Close recordset once program loop has finished.
DoCmd.SetWarnings False
db.Close
Set rst = Nothing 'Destroy the recordset object to free up memory space.
Set db = Nothing
Call FormatExcelExport
xlBook.SaveAs "C:\StockOfferLog\" & sAccount & Format(Date, "dd_mm_yyyy") & ".xls" 'Save the Excel file
xlBook.Close 'Close the Excel file.
xlApp.Quit
Set xlApp = Nothing 'Destroy the Excel object created by the program to free up memory space.
Exit_Line:
DoCmd.SetWarnings True
DoCmd.Hourglass False
Exit Function
Error_Handler:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_Line
End Function